ADGADSP2.m

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