- DGJOPRT1 ;MAF/ALB - INCOMPLETE REPORTS ; SEP 11 1991@10:00
- ;;5.3;Registration;**44,1015**;Aug 13, 1993;Build 21
- ;
- I $D(DGJTMUL),DGJTMUL D DIVISION^VAUTOMA G:Y=-1 QUIT
- I 'DGJTMUL S DGJTDV=$O(^DG(40.8,0))
- D @(DGJTL) G:Y=-1 QUIT
- I DGJTL'="DAT" D DAT G:Y=-1 QUIT
- S DIC("S")="I $S(""^OP REPORT^INTERIM SUMMARY^DISCHARGE SUMMARY^""[$P(^VAS(393.3,+Y,0),U,1):1,1:0)"
- S VAUTVB="VAUTY",DIC="^VAS(393.3,",VAUTSTR="Summary Type",VAUTNI=2 D FIRST^VAUTOMA Q:Y=-1
- W !!,*7,"This output requires 132 column output",!
- D NOW^%DTC S Y=$E(%,1,12) S VADAT("W")=Y D ^VADATE S DGJTDAT=VADATE("E")
- S DGVAR="DGJTDV^DGJTDIR^DGJTDAT^DGJTSTAT^DGJTCK^DGJTFL^DGJTMESS^DGJTSR^DGJTSR1^DGJTMUL^DGJTL^DGJTBG^DGJTEND^VAUTD#^VAUTN#^VAUTT#^VAUTY#",DGPGM="START^DGJOPRT1" D ZIS^DGUTQ I 'POP U IO G START^DGJOPRT1
- G QUIT
- START S (DGJTPAG,DGJTDV1)=0 F IFN=0:0 S IFN=$O(^VAS(393,IFN)) Q:'IFN S DGJTNODE=^VAS(393,IFN,0) D CK
- I $D(^UTILITY("VAS",$J)) S (DGJ,DGJTF,DGJTFF,DGJY,DGJTDV,DGJTDT,DGJTSV,DGJTSP,DGJTPHY,DGJTPT,DGU,DFN,IFN)=0,$P(DGJTLN,"=",133)="" G ^DGJOPRT2
- I '$D(^UTILITY("VAS",$J)) W !!,"NO RECORDS"
- QUIT K %DT,DIR,DGJTCK,DGJTBEG,DGJTBG,DGJTEND,DGJTDAT,DGJTDV,DGJFL,DGJTDIR,DGJTL,DGJTMESS,DGJTMUL,DGJTSR,DGJTSR1,DGJTSTAT,VAUTD,VAUTN,VAUTT,VADAT,VADATE,POP,X,Y
- D CLOSE^DGUTQ Q
- CNT I DGJTL'="SER" S DGJTOT(DGJTDVN)=DGJTOT(DGJTDVN)+1
- I DGJTL="SER" S DGJTOT(X)=DGJTOT(X)+1
- I DGJTL="PHY" S:'$D(DGJPHTOT(DGJTDVN,DGJTPHY)) DGJPHTOT(DGJTDVN,DGJTPHY)=0 S DGJPHTOT(DGJTDVN,DGJTPHY)=DGJPHTOT(DGJTDVN,DGJTPHY)+1 Q
- I DGJTL="SER" S:'$D(DGJSVTOT(DGJTDVN,DGJTSV)) DGJSVTOT(DGJTDVN,DGJTSV)=0 S DGJSVTOT(DGJTDVN,DGJTSV)=DGJSVTOT(DGJTDVN,DGJTSV)+1
- I DGJTL="SER" S:'$D(DGJSPTOT(DGJTDVN,DGJTSV,DGJTSP)) DGJSPTOT(DGJTDVN,DGJTSV,DGJTSP)=0 S DGJSPTOT(DGJTDVN,DGJTSV,DGJTSP)=DGJSPTOT(DGJTDVN,DGJTSV,DGJTSP)+1
- Q
- CK I $P(DGJTNODE,"^",6)']"" S $P(DGJTNODE,"^",6)=$O(^DG(40.8,0))
- I $D(VAUTD),'VAUTD I $P(DGJTNODE,"^",6)]"",'$D(VAUTD($P(DGJTNODE,"^",6))) Q
- I $D(DGJTDV),$P(DGJTNODE,"^",6)]"" I $P(DGJTNODE,"^",6)'=+DGJTDV Q
- I DGJTSR1=1,$P(DGJTNODE,"^",13)'=1 Q
- I DGJTSR1=2,$P(DGJTNODE,"^",13)]"" Q
- I DGJTSR1'=2 I $P(DGJTNODE,"^",2)=$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0)) S X=$P(DGJTNODE,"^",4) I X]"" I $D(^DGPM(X,0)) S X=$P(^DGPM(X,0),"^",17) Q:X']""
- S DGJTPC=$S(DGJTL="PAT":1,DGJTL="DAT":3,DGJTL="SER":8,DGJTL="PHY":14,1:"")
- Q:$P(DGJTNODE,"^",2)']"" Q:'$D(^VAS(393.3,$P(DGJTNODE,"^",2),0)) I "^OP REPORT^DISCHARGE SUMMARY^INTERIM SUMMARY^"'[$P(^VAS(393.3,$P(DGJTNODE,"^",2),0),"^",1) Q
- I $D(VAUTN),'VAUTN I '$D(VAUTN(+$P(DGJTNODE,"^",DGJTPC))) Q
- I $D(VAUTT),'VAUTT I '$D(VAUTT(+$P(DGJTNODE,"^",7))) Q
- I $D(VAUTY),'VAUTY I '$D(VAUTY(+$P(DGJTNODE,"^",2))) Q
- I $P(DGJTNODE,"^",3)<DGJTBG!($P(DGJTNODE,"^",3)>DGJTEND) Q
- D ^DGJTUDIS I 'DGJTFLAG Q
- S DGJTDIV=$P(DGJTNODE,"^",6),DGJTDVN=$S(DGJTDIV]"":DGJTDIV,1:$O(^DG(40.8,0))),DGJTDVN=$S($D(^DG(40.8,+DGJTDVN,0)):$P(^(0),"^",1),1:"NOT SPECIFIED") I '$D(DGJTOT(DGJTDVN)) S DGJTOT(DGJTDVN)=0
- S DFN=$P(DGJTNODE,"^",1) I $D(^DPT(DFN,0)) S DGJTPT=$P(^(0),"^",1)
- I DGJTL="PAT" S ^UTILITY("VAS",$J,DGJTDVN,DGJTPT,DFN,IFN)=DGJTDL D CNT Q
- I DGJTL="DAT" S DGJTDT=$P(DGJTNODE,"^",DGJTPC) S ^UTILITY("VAS",$J,DGJTDVN,DGJTDT,DGJTPT,DFN,IFN)=DGJTDL D CNT Q
- I DGJTL="PHY" S DGJTPHY=$S($P(DGJTNODE,"^",DGJTPC)]""&($D(^VA(200,+$P(DGJTNODE,"^",DGJTPC),0))):$P(^(0),"^",1),1:"NOT SPECIFIED") S ^UTILITY("VAS",$J,DGJTDVN,DGJTPHY,DGJTPT,DFN,IFN)=DGJTDL D CNT Q
- I DGJTL="SER" S DGJTSV=$S($P(DGJTNODE,"^",DGJTPC)]""&($D(^DG(393.1,+$P(DGJTNODE,"^",DGJTPC),0))):$P(^(0),"^",1),1:"NOT SPECIFIED"),DGJTSP=$S($P(DGJTNODE,"^",7)]""&($D(^DIC(45.7,+$P(DGJTNODE,"^",7),0))):$P(^(0),"^",1),1:"NOT SPECIFIED")
- I DGJTL="SER" S X=DGJTDVN,DGJTDVN=$E(DGJTDVN,1,23),DGJTSV=$E(DGJTSV,1,16),DGJTPT=$E(DGJTPT,1,16),DGJTSP=$E(DGJTSP,1,16) S ^UTILITY("VAS",$J,DGJTDVN,DGJTSV,DGJTSP,DGJTPT,DFN,IFN)=DGJTDL D CNT Q
- Q
- PAT S VAUTNI=2 D PATIENT^VAUTOMA
- Q
- PHY S VAUTVB="VAUTN",DIC="^VA(200,",VAUTSTR="Physician",VAUTNI=2 D FIRST^VAUTOMA S:Y=-1 DGJFL=1 Q:DGJFL
- Q
- DAT ;DATE RANGE
- BEG W ! S %DT="AEX",%DT("A")="START WITH EVENT DATE: " D ^%DT S DGJTBG=Y,DGJTBEG=Y-.0001 S:X="^"!(X="") Y=-1 Q:Y=-1
- END W ! S %DT("A")="END WITH EVENT DATE: " D ^%DT S:X="^"!(X="") Y=-1 Q:Y=-1 I Y<1 D HELP^%DTC G END
- S DGJTEND=Y_.9999
- I DGJTEND\1<DGJTBG W !!?5,"The ending date cannot be before the beginning date" G END
- Q
- SER S VAUTVB="VAUTN",DIC="^DG(393.1,",VAUTSTR="Service",VAUTNI=2 D FIRST^VAUTOMA Q:Y=-1
- S VAUTVB="VAUTT",DIC="^DIC(45.7,",VAUTSTR="Specialty",VAUTNI=2 D FIRST^VAUTOMA
- Q
- DGJOPRT1 ;MAF/ALB - INCOMPLETE REPORTS ; SEP 11 1991@10:00
- +1 ;;5.3;Registration;**44,1015**;Aug 13, 1993;Build 21
- +2 ;
- +3 IF $DATA(DGJTMUL)
- IF DGJTMUL
- DO DIVISION^VAUTOMA
- IF Y=-1
- GOTO QUIT
- +4 IF 'DGJTMUL
- SET DGJTDV=$ORDER(^DG(40.8,0))
- +5 DO @(DGJTL)
- IF Y=-1
- GOTO QUIT
- +6 IF DGJTL'="DAT"
- DO DAT
- IF Y=-1
- GOTO QUIT
- +7 SET DIC("S")="I $S(""^OP REPORT^INTERIM SUMMARY^DISCHARGE SUMMARY^""[$P(^VAS(393.3,+Y,0),U,1):1,1:0)"
- +8 SET VAUTVB="VAUTY"
- SET DIC="^VAS(393.3,"
- SET VAUTSTR="Summary Type"
- SET VAUTNI=2
- DO FIRST^VAUTOMA
- IF Y=-1
- QUIT
- +9 WRITE !!,*7,"This output requires 132 column output",!
- +10 DO NOW^%DTC
- SET Y=$EXTRACT(%,1,12)
- SET VADAT("W")=Y
- DO ^VADATE
- SET DGJTDAT=VADATE("E")
- +11 SET DGVAR="DGJTDV^DGJTDIR^DGJTDAT^DGJTSTAT^DGJTCK^DGJTFL^DGJTMESS^DGJTSR^DGJTSR1^DGJTMUL^DGJTL^DGJTBG^DGJTEND^VAUTD#^VAUTN#^VAUTT#^VAUTY#"
- SET DGPGM="START^DGJOPRT1"
- DO ZIS^DGUTQ
- IF 'POP
- USE IO
- GOTO START^DGJOPRT1
- +12 GOTO QUIT
- START SET (DGJTPAG,DGJTDV1)=0
- FOR IFN=0:0
- SET IFN=$ORDER(^VAS(393,IFN))
- IF 'IFN
- QUIT
- SET DGJTNODE=^VAS(393,IFN,0)
- DO CK
- +1 IF $DATA(^UTILITY("VAS",$JOB))
- SET (DGJ,DGJTF,DGJTFF,DGJY,DGJTDV,DGJTDT,DGJTSV,DGJTSP,DGJTPHY,DGJTPT,DGU,DFN,IFN)=0
- SET $PIECE(DGJTLN,"=",133)=""
- GOTO ^DGJOPRT2
- +2 IF '$DATA(^UTILITY("VAS",$JOB))
- WRITE !!,"NO RECORDS"
- QUIT KILL %DT,DIR,DGJTCK,DGJTBEG,DGJTBG,DGJTEND,DGJTDAT,DGJTDV,DGJFL,DGJTDIR,DGJTL,DGJTMESS,DGJTMUL,DGJTSR,DGJTSR1,DGJTSTAT,VAUTD,VAUTN,VAUTT,VADAT,VADATE,POP,X,Y
- +1 DO CLOSE^DGUTQ
- QUIT
- CNT IF DGJTL'="SER"
- SET DGJTOT(DGJTDVN)=DGJTOT(DGJTDVN)+1
- +1 IF DGJTL="SER"
- SET DGJTOT(X)=DGJTOT(X)+1
- +2 IF DGJTL="PHY"
- IF '$DATA(DGJPHTOT(DGJTDVN,DGJTPHY))
- SET DGJPHTOT(DGJTDVN,DGJTPHY)=0
- SET DGJPHTOT(DGJTDVN,DGJTPHY)=DGJPHTOT(DGJTDVN,DGJTPHY)+1
- QUIT
- +3 IF DGJTL="SER"
- IF '$DATA(DGJSVTOT(DGJTDVN,DGJTSV))
- SET DGJSVTOT(DGJTDVN,DGJTSV)=0
- SET DGJSVTOT(DGJTDVN,DGJTSV)=DGJSVTOT(DGJTDVN,DGJTSV)+1
- +4 IF DGJTL="SER"
- IF '$DATA(DGJSPTOT(DGJTDVN,DGJTSV,DGJTSP))
- SET DGJSPTOT(DGJTDVN,DGJTSV,DGJTSP)=0
- SET DGJSPTOT(DGJTDVN,DGJTSV,DGJTSP)=DGJSPTOT(DGJTDVN,DGJTSV,DGJTSP)+1
- +5 QUIT
- CK IF $PIECE(DGJTNODE,"^",6)']""
- SET $PIECE(DGJTNODE,"^",6)=$ORDER(^DG(40.8,0))
- +1 IF $DATA(VAUTD)
- IF 'VAUTD
- IF $PIECE(DGJTNODE,"^",6)]""
- IF '$DATA(VAUTD($PIECE(DGJTNODE,"^",6)))
- QUIT
- +2 IF $DATA(DGJTDV)
- IF $PIECE(DGJTNODE,"^",6)]""
- IF $PIECE(DGJTNODE,"^",6)'=+DGJTDV
- QUIT
- +3 IF DGJTSR1=1
- IF $PIECE(DGJTNODE,"^",13)'=1
- QUIT
- +4 IF DGJTSR1=2
- IF $PIECE(DGJTNODE,"^",13)]""
- QUIT
- +5 IF DGJTSR1'=2
- IF $PIECE(DGJTNODE,"^",2)=$ORDER(^VAS(393.3,"B","DISCHARGE SUMMARY",0))
- SET X=$PIECE(DGJTNODE,"^",4)
- IF X]""
- IF $DATA(^DGPM(X,0))
- SET X=$PIECE(^DGPM(X,0),"^",17)
- IF X']""
- QUIT
- +6 SET DGJTPC=$SELECT(DGJTL="PAT":1,DGJTL="DAT":3,DGJTL="SER":8,DGJTL="PHY":14,1:"")
- +7 IF $PIECE(DGJTNODE,"^",2)']""
- QUIT
- IF '$DATA(^VAS(393.3,$PIECE(DGJTNODE,"^",2),0))
- QUIT
- IF "^OP REPORT^DISCHARGE SUMMARY^INTERIM SUMMARY^"'[$PIECE(^VAS(393.3,$PIECE(DGJTNODE,"^",2),0),"^",1)
- QUIT
- +8 IF $DATA(VAUTN)
- IF 'VAUTN
- IF '$DATA(VAUTN(+$PIECE(DGJTNODE,"^",DGJTPC)))
- QUIT
- +9 IF $DATA(VAUTT)
- IF 'VAUTT
- IF '$DATA(VAUTT(+$PIECE(DGJTNODE,"^",7)))
- QUIT
- +10 IF $DATA(VAUTY)
- IF 'VAUTY
- IF '$DATA(VAUTY(+$PIECE(DGJTNODE,"^",2)))
- QUIT
- +11 IF $PIECE(DGJTNODE,"^",3)<DGJTBG!($PIECE(DGJTNODE,"^",3)>DGJTEND)
- QUIT
- +12 DO ^DGJTUDIS
- IF 'DGJTFLAG
- QUIT
- +13 SET DGJTDIV=$PIECE(DGJTNODE,"^",6)
- SET DGJTDVN=$SELECT(DGJTDIV]"":DGJTDIV,1:$ORDER(^DG(40.8,0)))
- SET DGJTDVN=$SELECT($DATA(^DG(40.8,+DGJTDVN,0)):$PIECE(^(0),"^",1),1:"NOT SPECIFIED")
- IF '$DATA(DGJTOT(DGJTDVN))
- SET DGJTOT(DGJTDVN)=0
- +14 SET DFN=$PIECE(DGJTNODE,"^",1)
- IF $DATA(^DPT(DFN,0))
- SET DGJTPT=$PIECE(^(0),"^",1)
- +15 IF DGJTL="PAT"
- SET ^UTILITY("VAS",$JOB,DGJTDVN,DGJTPT,DFN,IFN)=DGJTDL
- DO CNT
- QUIT
- +16 IF DGJTL="DAT"
- SET DGJTDT=$PIECE(DGJTNODE,"^",DGJTPC)
- SET ^UTILITY("VAS",$JOB,DGJTDVN,DGJTDT,DGJTPT,DFN,IFN)=DGJTDL
- DO CNT
- QUIT
- +17 IF DGJTL="PHY"
- SET DGJTPHY=$SELECT($PIECE(DGJTNODE,"^",DGJTPC)]""&($DATA(^VA(200,+$PIECE(DGJTNODE,"^",DGJTPC),0))):$PIECE(^(0),"^",1),1:"NOT SPECIFIED")
- SET ^UTILITY("VAS",$JOB,DGJTDVN,DGJTPHY,DGJTPT,DFN,IFN)=DGJTDL
- DO CNT
- QUIT
- +18 IF DGJTL="SER"
- SET DGJTSV=$SELECT($PIECE(DGJTNODE,"^",DGJTPC)]""&($DATA(^DG(393.1,+$PIECE(DGJTNODE,"^",DGJTPC),0))):$PIECE(^(0),"^",1),1:"NOT SPECIFIED")
- SET DGJTSP=$SELECT($PIECE(DGJTNODE,"^",7)]""&($DATA(^DIC(45.7,+$PIECE(DGJTNODE,"^",7),0))):$PIECE(^(0),"^",1),1:"NOT SPECIFIED")
- +19 IF DGJTL="SER"
- SET X=DGJTDVN
- SET DGJTDVN=$EXTRACT(DGJTDVN,1,23)
- SET DGJTSV=$EXTRACT(DGJTSV,1,16)
- SET DGJTPT=$EXTRACT(DGJTPT,1,16)
- SET DGJTSP=$EXTRACT(DGJTSP,1,16)
- SET ^UTILITY("VAS",$JOB,DGJTDVN,DGJTSV,DGJTSP,DGJTPT,DFN,IFN)=DGJTDL
- DO CNT
- QUIT
- +20 QUIT
- PAT SET VAUTNI=2
- DO PATIENT^VAUTOMA
- +1 QUIT
- PHY SET VAUTVB="VAUTN"
- SET DIC="^VA(200,"
- SET VAUTSTR="Physician"
- SET VAUTNI=2
- DO FIRST^VAUTOMA
- IF Y=-1
- SET DGJFL=1
- IF DGJFL
- QUIT
- +1 QUIT
- DAT ;DATE RANGE
- BEG WRITE !
- SET %DT="AEX"
- SET %DT("A")="START WITH EVENT DATE: "
- DO ^%DT
- SET DGJTBG=Y
- SET DGJTBEG=Y-.0001
- IF X="^"!(X="")
- SET Y=-1
- IF Y=-1
- QUIT
- END WRITE !
- SET %DT("A")="END WITH EVENT DATE: "
- DO ^%DT
- IF X="^"!(X="")
- SET Y=-1
- IF Y=-1
- QUIT
- IF Y<1
- DO HELP^%DTC
- GOTO END
- +1 SET DGJTEND=Y_.9999
- +2 IF DGJTEND\1<DGJTBG
- WRITE !!?5,"The ending date cannot be before the beginning date"
- GOTO END
- +3 QUIT
- SER SET VAUTVB="VAUTN"
- SET DIC="^DG(393.1,"
- SET VAUTSTR="Service"
- SET VAUTNI=2
- DO FIRST^VAUTOMA
- IF Y=-1
- QUIT
- +1 SET VAUTVB="VAUTT"
- SET DIC="^DIC(45.7,"
- SET VAUTSTR="Specialty"
- SET VAUTNI=2
- DO FIRST^VAUTOMA
- +2 QUIT
