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 ---[H[J[2J[HDGODCV 1905 printed Dec 13, 2024@02:46:21 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
