- 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 Jan 18, 2025@03:47:02 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