- ADGADSP2 ; IHS/ADC/PDW/ENM - A & D SHEET-DAY SURGERY (DETAILED) ; [ 03/25/1999 11:48 AM ]
- ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- ;
- ;***> detailed version of A & D SHEET (Day Surgery section)
- ;
- S DGDSD=DGDATE-.0001,DGDAYCT=0 ;loop thru by date/time
- A1 S DGDSD=$O(^ADGDS("AA",DGDSD)) G A4:DGDSD="",A4:DGDSD'<(DGDATE_".9999")
- S DFN=0 ;witin date/time loop thru by patient to find surgery entry
- A2 S DFN=$O(^ADGDS("AA",DGDSD,DFN)) G A1:DFN="" S DGDSN=0
- A3 S DGDSN=$O(^ADGDS("AA",DGDSD,DFN,DGDSN)) G A2:DGDSN=""
- ;
- G A3:'$D(^ADGDS(DFN,"DS",DGDSN,0)) S DGSTR=^(0)
- S DGVLG=$$VAL^XBDIQ1(9000001,DFN,1118) ;community
- S AGE=$$VAL^XBDIQ1(9000001,DFN,1102.98)
- S DGPR=$$VAL^XBDIQ1(200,+$P(DGSTR,U,6),.01) ;provider
- S DGSER=$$VAL^XBDIQ1(45.7,+$P(DGSTR,U,5),.01)
- S DGDS(DFN)=DGPR_U_AGE_U_DGSER_U_DGVLG
- S DGDAYCT=DGDAYCT+1 ;increment count
- G A3 ;print data and return for more
- ;
- A4 ;
- S X="SRZPEP" X ^%ZOSF("TEST") I $T D ADS^SRZPEP("D")
- G END:DGDAYCT=0 ;skip if none for date
- W !!,"DAY SURGERIES:",!
- S DFN=0 F S DFN=$O(DGDS(DFN)) Q:'DFN D WRITE
- W !!,"TOTAL DAY SURGERIES: ",DGDAYCT
- ;
- END G END1^ADGADSP1
- ;
- WRITE ;***> subrtn to print each line
- S DGNM=$P(^DPT(DFN,0),U) ;patient name
- W !?10,$E(DGNM,1,24)
- S DGCHT=$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2),DGCHT="00000"_DGCHT
- S DGCHTX=$E(DGCHT,$L(DGCHT)-5,$L(DGCHT))
- W ?37,$E(DGCHTX,1,2)_"-"_$E(DGCHTX,3,4)_"-"_$E(DGCHTX,5,6)
- W ?47,$E($P(DGDS(DFN),U),1,21),?71,$P(DGDS(DFN),U,2) ;provider & age
- W ?80,$E($P(DGDS(DFN),U,3),1,3),?90,$P(DGDS(DFN),U,4) ;srv&community
- D:$Y>(IOSL-5) NEWPG^ADGADSP1
- W9 Q
- ADGADSP2 ; IHS/ADC/PDW/ENM - A & D SHEET-DAY SURGERY (DETAILED) ; [ 03/25/1999 11:48 AM ]
- +1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- +2 ;
- +3 ;***> detailed version of A & D SHEET (Day Surgery section)
- +4 ;
- +5 ;loop thru by date/time
- SET DGDSD=DGDATE-.0001
- SET DGDAYCT=0
- A1 SET DGDSD=$ORDER(^ADGDS("AA",DGDSD))
- IF DGDSD=""
- GOTO A4
- IF DGDSD'<(DGDATE_".9999")
- GOTO A4
- +1 ;witin date/time loop thru by patient to find surgery entry
- SET DFN=0
- A2 SET DFN=$ORDER(^ADGDS("AA",DGDSD,DFN))
- IF DFN=""
- GOTO A1
- SET DGDSN=0
- A3 SET DGDSN=$ORDER(^ADGDS("AA",DGDSD,DFN,DGDSN))
- IF DGDSN=""
- GOTO A2
- +1 ;
- +2 IF '$DATA(^ADGDS(DFN,"DS",DGDSN,0))
- GOTO A3
- SET DGSTR=^(0)
- +3 ;community
- SET DGVLG=$$VAL^XBDIQ1(9000001,DFN,1118)
- +4 SET AGE=$$VAL^XBDIQ1(9000001,DFN,1102.98)
- +5 ;provider
- SET DGPR=$$VAL^XBDIQ1(200,+$PIECE(DGSTR,U,6),.01)
- +6 SET DGSER=$$VAL^XBDIQ1(45.7,+$PIECE(DGSTR,U,5),.01)
- +7 SET DGDS(DFN)=DGPR_U_AGE_U_DGSER_U_DGVLG
- +8 ;increment count
- SET DGDAYCT=DGDAYCT+1
- +9 ;print data and return for more
- GOTO A3
- +10 ;
- A4 ;
- +1 SET X="SRZPEP"
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- DO ADS^SRZPEP("D")
- +2 ;skip if none for date
- IF DGDAYCT=0
- GOTO END
- +3 WRITE !!,"DAY SURGERIES:",!
- +4 SET DFN=0
- FOR
- SET DFN=$ORDER(DGDS(DFN))
- IF 'DFN
- QUIT
- DO WRITE
- +5 WRITE !!,"TOTAL DAY SURGERIES: ",DGDAYCT
- +6 ;
- END GOTO END1^ADGADSP1
- +1 ;
- WRITE ;***> subrtn to print each line
- +1 ;patient name
- SET DGNM=$PIECE(^DPT(DFN,0),U)
- +2 WRITE !?10,$EXTRACT(DGNM,1,24)
- +3 SET DGCHT=$PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
- SET DGCHT="00000"_DGCHT
- +4 SET DGCHTX=$EXTRACT(DGCHT,$LENGTH(DGCHT)-5,$LENGTH(DGCHT))
- +5 WRITE ?37,$EXTRACT(DGCHTX,1,2)_"-"_$EXTRACT(DGCHTX,3,4)_"-"_$EXTRACT(DGCHTX,5,6)
- +6 ;provider & age
- WRITE ?47,$EXTRACT($PIECE(DGDS(DFN),U),1,21),?71,$PIECE(DGDS(DFN),U,2)
- +7 ;srv&community
- WRITE ?80,$EXTRACT($PIECE(DGDS(DFN),U,3),1,3),?90,$PIECE(DGDS(DFN),U,4)
- +8 IF $Y>(IOSL-5)
- DO NEWPG^ADGADSP1
- W9 QUIT
