Return to DIFGG4.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFGG4.m, revision 1.1

1.1     ! snw         1: DIFGG4 ;SFISC/XAK,EDE(OHPRD)-FILEGRAM SUBFILES ;6/10/93  1:41 PM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: SUBFILE        ; DO ONE SUBFILE
        !             5:        F DIFG(DILL,"FE")=0:0 S DIFG(DILL,"FE")=$O(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_")")) Q:DIFG(DILL,"FE")'=+DIFG(DILL,"FE")  D SUBENTRY
        !             6:        Q
        !             7:        ;
        !             8: SUBENTRY       ; DO ONE SUBFILE ENTRY
        !             9:        D DIS Q:'$T
        !            10:        D DR S DR(DIFG(DILL,"FILE"))=.01
        !            11:        S DIFG(DILL,"MUL")=1
        !            12:        D LOOKUP^DIFGGU
        !            13:        I $D(DIFGGUQ) K DIFGGUQ,DIFG(DILL,"MUL") Q
        !            14:        D DR,DRS
        !            15:        D RECURSEM
        !            16:        S V="^" D INCSET^DIFGGU
        !            17:        K DIFG(DILL,"MUL"),DA,DR
        !            18:        Q
        !            19:        ;
        !            20: DR     ; CREATE DR-STRINGS
        !            21:        K DR S I=0
        !            22:        F %=DIFG(DILL,"FILE"):0 Q:'$D(^DD(%,0,"UP"))  S X=^("UP"),Y=$O(^DD(X,"SB",%,0)),DR(X)=Y,DA(%)=DIFG(DILL-I,"FE"),%=X,I=I+1
        !            23:        S DA=DIFG(DILL-I,"FE"),DIC=DIFG(DILL-I,"FILE"),DR=DR(%) K DR(%)
        !            24:        Q
        !            25:        ;
        !            26: DRS    ; PROCESS ALL DR STRINGS FOR FILE
        !            27:        S DR(DIFG(DILL,"FILE"))="",DITAB=DITAB+2
        !            28:        I $P(^DIPT(DIFGT,1,DIFGI,0),U,8) F DIFG2=.001:0 S %=DIFG(DILL,"FILE"),DIFG2=$O(^DD(%,DIFG2)) Q:DIFG2'>0  D DRA
        !            29:        F DIFG2=0:0 S DIFG2=$O(^DIPT(DIFGT,1,DIFGI,"F",DIFG2)) Q:DIFG2'=+DIFG2  I $D(^(DIFG2,0)) S DR(DIFG(DILL,"FILE"))=DR(DIFG(DILL,"FILE"))_^(0)_";" I $L(DR(DIFG(DILL,"FILE")))>200 D EN^DIFGG2 S DR(DIFG(DILL,"FILE"))=""
        !            30:        D EN^DIFGG2:DR(DIFG(DILL,"FILE"))]""
        !            31:        S DITAB=DITAB-2
        !            32:        Q
        !            33:        ;
        !            34: DRA    ;Process all subfields
        !            35:        S %1=$P(^(0),U,0) I $S('%1:%1'["C",1:$P(^DD(+%1,.01,0),U,2)["W") S DR(%)=DR(%)_DIFG2_";" I $L(DR(%))>200 D EN^DIFGG2 S %=DIFG(DILL,"FILE"),DR(%)=""
        !            36:        Q
        !            37:        ;
        !            38: DIS    ; SCREEN THIS ENTRY
        !            39:        F %=1:1:DILL S @("D"_(%-1))=DIFG(%,"FE")
        !            40:        I $D(DIFG(DIFG(DILL,"FILE"),"S"))#2 X DIFG(DIFG(DILL,"FILE"),"S") Q
        !            41:        I 1 Q
        !            42:        ;
        !            43: RECURSEM       ; RECURSION FOR DEEPER SUBFILE SHIFTS
        !            44:        S DITAB=DITAB+2
        !            45:        D NEXTLVL^DIFGG
        !            46:        S DITAB=DITAB-2
        !            47:        Q
        !            48:        ;
        !            49:        ;
        !            50: DIFGG3 ; FILEGRAM NAVIGATION
        !            51:        ; SEE DIFGG3^DIFGGDOC
        !            52:        ;
        !            53: FILE   ; PROCESS ONE FILE
        !            54:        F DIFG(DILL,"FE")=0:0 D FILE2 Q:DIFG(DILL,"FE")=""  D ENTRY
        !            55:        K I,S,V,X
        !            56:        Q
        !            57:        ;
        !            58: FILE2  ;
        !            59:        S X=$O(^DD(DIFG(DILL,"FILE"),0,"IX",DIFG(DILL,"XREF"),0))
        !            60:        Q:'X
        !            61:        S Y=$O(^DD(DIFG(DILL,"FILE"),0,"IX",DIFG(DILL,"XREF"),X,0))
        !            62:        Q:'Y
        !            63:        I $P(^DD(X,Y,0),U,2)["V" S DIFG(DILL,"FSV")=""""_DIFG(DILL-1,"FE")_";"_$P(^DIC(DIFG(DILL-1,"FILE"),0,"GL"),U,2)_"""" I 1
        !            64:        E  S DIFG(DILL,"FSV")=DIFG(DILL-1,"FE")
        !            65:        S DIFG(DILL,"FE")=$O(@(DIFG(DILL,"FGBL")_""""_DIFG(DILL,"XREF")_""","_DIFG(DILL,"FSV")_","_DIFG(DILL,"FE")_")"))
        !            66:        Q
        !            67:        ;
        !            68: ENTRY  ; PROCESS ONE FILE ENTRY
        !            69:        S DIFG(DILL,"NAV")=1
        !            70:        D LOOKUP^DIFGGU
        !            71:        K DIFG(DILL,"NAV")
        !            72:        I $D(DIFGGUQ) K DIFGGUQ Q
        !            73:        S DITAB=DITAB+2
        !            74:        D ^DIFGG2
        !            75:        D RECURSEF
        !            76:        S DITAB=2*(DILL-1)
        !            77:        S V=":" D INCSET^DIFGGU
        !            78:        Q
        !            79:        ;
        !            80: RECURSEF       ; RECURSION FOR DEEPER FILE SHIFTS
        !            81:        D NEXTLVL^DIFGG
        !            82:        Q