DGODCV.m

DGODCV ;ALB/EG - STORE GENERATED REPORT INTO VAMC FILEMAN ; 11 APR 89

 ;;5.3;Registration;;Aug 13, 1993

 ;;V 4.5

 S U="^",(DGTN,DGDV,DGV,DGMT,DGEL)=""

 S DGTOP1=$S(DGJB=2:1,1:3),GOX=$S(DGJB=1:"AO",1:"AI") F DGTN=1:1:DGTOP1 D @GOX

 K %DT,AX,DA,DFN,DGL,DGPT,DGREP,DGSTN,DGSTN1,DGTOP,DGTOP1,DGTYPE,DIC,DLAYGO,GOX,X5 Q

AO S DGDV="" F I=1:1 S DGDV=$O(^UTILITY("DGOD",$J,DGJB,DGTN,DGDV)) Q:(DGDV="")!(DGDV="TOT")  I $D(^UTILITY("DGOD",$J,DGJB,DGTN,DGDV))>0&(^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,"TOT","N")+^("V")>0) D ENTY,2

 Q

AI S DGDV="" F I=1:1 S DGDV=$O(^UTILITY("DGOD",$J,DGJB,DGTN,DGDV)) Q:(DGDV="")!(DGDV="TOT")  D AI1

 Q

AI1 I ($P(^UTILITY("DGOD",$J,DGJB,DGTN,DGDV),U,7)>0)&($D(^UTILITY("DGOD",$J,DGJB,DGTN,DGDV))=1) D ENTY Q

 I ($D(^UTILITY("DGOD",$J,DGJB,DGTN,DGDV))=11)&(^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,"TOT","N")+^("V")>0) D ENTY,2

 Q

2 F DGV="V","N" S DGTOP=$S(DGV="V":6,1:8) F DGEL=1:1:DGTOP,"*" D 3

 Q

3 S DGL=$S((DGV="V")&(DGEL'="*"):DGEL,(DGV="V")&(DGEL="*"):7,(DGV="N")&(DGEL="*"):16,1:DGEL+7)

 S I1=0 F DGMT="AS","AN","B","C","N","X","U" S I1=I1+1,AX(I1)=^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,DGV,DGMT,DGEL)

 S DA=DFN,DIE="^VAT(408,",DR="5///0"_";6///"_DGTOUT_";8///"_DGL

 S DR(2,408.08)="1///"_AX(1)_";2///"_AX(2)_";3///"_AX(3)_";4///"_AX(4)_";5///"_AX(5)_";6///"_AX(6)_";7///"_AX(7) D ^DIE K DR

 Q

ENTY ;stuff run date (.01)

 S DIC="^VAT(408,",DLAYGO=408,DIC(0)="L",%DT="TS",X="N" D ^%DT S X=Y,DGSTN=$P(^DG(40.8,1,0),U,1),DGSTN1=$P(^DIC(4,$P(^DG(40.8,1,0),U,7),99),U,1)

LOCK L ^VAT(408,+X):1 I '$T!$D(^VAT(408,+X)) L  S X=X+.000001 G LOCK

 S X5=^UTILITY("DGOD",$J,DGJB,DGTN,DGDV),DGTOUT=$S(DGJB=1:$P(X5,U,7),1:$P(X5,U,8)),DGPT=$S(DGJB=2:$P(X5,U,7),1:"")

 S DGTYPE=$S(DGJB=2:2,(DGJB=1)&(DGTN=1):1,(DGJB=1)&(DGTN=2):4,(DGJB=1)&(DGTN=3):3,1:0),DIC("DR")="1///"_DGREP_";2///"_DGDV_";3///"_DGSTN1_";4///"_DGTYPE_";9///"_DGPT D ^DIC S DFN=$P(Y,U,1),DA=DFN K DR,DIC("DR")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGODCV   1905     printed  Apr 09, 2024@21:53:50                                                                                                                                                                                                      Page 2

DGODCV    ;ALB/EG - STORE GENERATED REPORT INTO VAMC FILEMAN ; 11 APR 89

 +1       ;;5.3;Registration;;Aug 13, 1993

 +2       ;;V 4.5

 +3        SET U="^"

           SET (DGTN,DGDV,DGV,DGMT,DGEL)=""

 +4        SET DGTOP1=$SELECT(DGJB=2:1,1:3)

           SET GOX=$SELECT(DGJB=1:"AO",1:"AI")

           FOR DGTN=1:1:DGTOP1

               DO @GOX

 +5        KILL %DT,AX,DA,DFN,DGL,DGPT,DGREP,DGSTN,DGSTN1,DGTOP,DGTOP1,DGTYPE,DIC,DLAYGO,GOX,X5

           QUIT 

AO         SET DGDV=""

           FOR I=1:1

               SET DGDV=$ORDER(^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV))

               if (DGDV="")!(DGDV="TOT")

                   QUIT 

               IF $DATA(^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV))>0&(^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,"TOT","N")+^("V")>0)

                   DO ENTY

                   DO 2

 +1        QUIT 

AI         SET DGDV=""

           FOR I=1:1

               SET DGDV=$ORDER(^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV))

               if (DGDV="")!(DGDV="TOT")

                   QUIT 

               DO AI1

 +1        QUIT 

AI1        IF ($PIECE(^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV),U,7)>0)&($DATA(^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV))=1)

               DO ENTY

               QUIT 

 +1        IF ($DATA(^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV))=11)&(^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,"TOT","N")+^("V")>0)

               DO ENTY

               DO 2

 +2        QUIT 

2          FOR DGV="V","N"

               SET DGTOP=$SELECT(DGV="V":6,1:8)

               FOR DGEL=1:1:DGTOP,"*"

                   DO 3

 +1        QUIT 

3          SET DGL=$SELECT((DGV="V")&(DGEL'="*"):DGEL,(DGV="V")&(DGEL="*"):7,(DGV="N")&(DGEL="*"):16,1:DGEL+7)

 +1        SET I1=0

           FOR DGMT="AS","AN","B","C","N","X","U"

               SET I1=I1+1

               SET AX(I1)=^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,DGV,DGMT,DGEL)

 +2        SET DA=DFN

           SET DIE="^VAT(408,"

           SET DR="5///0"_";6///"_DGTOUT_";8///"_DGL

 +3        SET DR(2,408.08)="1///"_AX(1)_";2///"_AX(2)_";3///"_AX(3)_";4///"_AX(4)_";5///"_AX(5)_";6///"_AX(6)_";7///"_AX(7)

           DO ^DIE

           KILL DR

 +4        QUIT 

ENTY      ;stuff run date (.01)

 +1        SET DIC="^VAT(408,"

           SET DLAYGO=408

           SET DIC(0)="L"

           SET %DT="TS"

           SET X="N"

           DO ^%DT

           SET X=Y

           SET DGSTN=$PIECE(^DG(40.8,1,0),U,1)

           SET DGSTN1=$PIECE(^DIC(4,$PIECE(^DG(40.8,1,0),U,7),99),U,1)

LOCK       LOCK ^VAT(408,+X):1

           IF '$TEST!$DATA(^VAT(408,+X))

               LOCK 

               SET X=X+.000001

               GOTO LOCK

 +1        SET X5=^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV)

           SET DGTOUT=$SELECT(DGJB=1:$PIECE(X5,U,7),1:$PIECE(X5,U,8))

           SET DGPT=$SELECT(DGJB=2:$PIECE(X5,U,7),1:"")

 +2        SET DGTYPE=$SELECT(DGJB=2:2,(DGJB=1)&(DGTN=1):1,(DGJB=1)&(DGTN=2):4,(DGJB=1)&(DGTN=3):3,1:0)

           SET DIC("DR")="1///"_DGREP_";2///"_DGDV_";3///"_DGSTN1_";4///"_DGTYPE_";9///"_DGPT

           DO ^DIC

           SET DFN=$PIECE(Y,U,1)

           SET DA=DFN

           KILL DR,DIC("DR")

 +3        QUIT