ADGDSAU ; IHS/ADC/PDW/ENM - DAY SURGERY AUDIT REPORT ; [ 06/19/2000 10:43 AM ]
;;5.0;ADMISSION/DISCHARGE/TRANSFER;**5**;MAR 25, 1999
;
I '$D(DGOPT) D VAR^ADGVAR ;ADT site parameter variables
W @IOF,!!!?28,"DAY SURGERY AUDIT REPORT",!!
BDATE S %DT="AEQ",%DT("A")="Select beginning date: ",X="" D ^%DT
G END:Y=-1 S DGBDT=Y
EDATE S %DT="AEQ",%DT("A")="Select ending date: ",X="" D ^%DT
G END:Y=-1 S DGEDT=Y
W !!,"Report uses 132 columns; use wide printer or condensed print!"
S %ZIS="PQ" D ^%ZIS G END:POP,QUE:$D(IO("Q")) U IO G CALC
QUE K IO("Q") S ZTRTN="CALC^ADGDSAU",ZTDESC="DAY SURG AUDIT"
S ZTSAVE("DGBDT")="",ZTSAVE("DGEDT")="",ZTSAVE("DGOPT(")=""
D ^%ZTLOAD D ^%ZISC K ZTSK
END K Y,DGBDT,DGEDT D HOME^%ZIS Q
;
;
CALC ;***> set up sorted Utility file for date range
;***> loop thru file by surgery date
S DGDT=DGBDT-.0001,DGEDT=DGEDT+.2400 K ^TMP("DGDSAU",$J)
S DGX=DGDT ;IHS/DSD/ENM 06/19/2000
C1 S DGDT=$O(^ADGDS("AA",DGDT)) G NEXT:DGDT="",NEXT:DGDT>DGEDT S DFN=0
C2 S DFN=$O(^ADGDS("AA",DGDT,DFN)) G C1:DFN="" S DGDFN1=0
C3 S DGDFN1=$O(^ADGDS("AA",DGDT,DFN,DGDFN1)) G C2:DGDFN1=""
;
G C3:'$D(^ADGDS(DFN,0)),C3:'$D(^ADGDS(DFN,"DS",DGDFN1,0)) S DGSTR=^(0)
S (AGE,DGPRC,DGSRV,DGOBS,DGADM,DGADWK,DGCAN,DGUNES,DGNM,DGNS,DGCMT)=""
S DGNM=$P(^DPT(DFN,0),U) ;patient name
S DGCHT=$S($D(^AUPNPAT(DFN,41,DUZ(2),0)):$P(^(0),U,2),1:"??") ;chrt
S AGE=$$VAL^XBDIQ1(9000001,DFN,1102.99)
S DGPRC=$P(DGSTR,U,2),DGSRV=$P(DGSTR,U,5) ;procedure/service
S DGLOS=$$VAL^XBDIQ1(9009012.01,"DFN,DGDFN1",8) ;length of stay
S DGOBS=$$VAL^XBDIQ1(9009012.01,"DFN,DGDFN1",10) ;los in observ
S:DGSRV'="" DGSRV=$S($D(^DIC(45.7,DGSRV,0)):$P(^(0),U),1:DGSRV) ;srv
S DGSTR2=$G(^ADGDS(DFN,"DS",DGDFN1,2)),DGADM=$P(DGSTR2,U,2) ;admitted?
S DGCAN=$P(DGSTR2,U,3),DGNS=$P(DGSTR2,U,4) ;cancel?/no-show?
S DGUNES=$P(DGSTR2,U,5),DGCMT=$P(DGSTR2,U,6) ;unescorted?/comments
G C4:DGADM'="Y" S X=DGDT-.0001,DGADM="??" ;no admission found
;
;***> find if patient admitted w/in time limit for day surgery
S DGREL=$S($D(DGSTR2):$P(DGSTR2,U),1:"")
S DGX1=$S(DGREL'="":DGREL,1:DGDT)
F S DGX=$O(^DGPM("AMV1",DGX)) Q:DGX="" Q:DGX>(DGX1+1) I $D(^DGPM("AMV1",DGX,DFN)) S DGY=$O(^DGPM("AMV1",DGX,DFN,0)),DGADM=$P(^DGPM(DGY,0),U) Q
G C5
C4 S Y=9999999-DGDT,X1=$P(DGDT,"."),X2=$P(DGOPT("QA1"),U,2) D C^%DTC
S DGX=9999999-X,DGX=$O(^DGPM("ATID1",DGX))
I DGX'="",DGX'>Y S DGADWK=9999999-DGX
;
;***> set utility file to sort by date, service, name
C5 S ^TMP("DGDSAU",$J,$P(DGDT,"."),DGSRV,DGNM,DFN,DGDFN1)=DGCHT_U_AGE_U_DGPRC_U_DGLOS_U_DGOBS_U_DGADM_U_DGADWK_U_DGCAN_U_DGUNES_U_DGNS_U_DGCMT G C3
;
NEXT G ^ADGDSAU1
ADGDSAU ; IHS/ADC/PDW/ENM - DAY SURGERY AUDIT REPORT ; [ 06/19/2000 10:43 AM ]
+1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;**5**;MAR 25, 1999
+2 ;
+3 ;ADT site parameter variables
IF '$DATA(DGOPT)
DO VAR^ADGVAR
+4 WRITE @IOF,!!!?28,"DAY SURGERY AUDIT REPORT",!!
BDATE SET %DT="AEQ"
SET %DT("A")="Select beginning date: "
SET X=""
DO ^%DT
+1 IF Y=-1
GOTO END
SET DGBDT=Y
EDATE SET %DT="AEQ"
SET %DT("A")="Select ending date: "
SET X=""
DO ^%DT
+1 IF Y=-1
GOTO END
SET DGEDT=Y
+2 WRITE !!,"Report uses 132 columns; use wide printer or condensed print!"
+3 SET %ZIS="PQ"
DO ^%ZIS
IF POP
GOTO END
IF $DATA(IO("Q"))
GOTO QUE
USE IO
GOTO CALC
QUE KILL IO("Q")
SET ZTRTN="CALC^ADGDSAU"
SET ZTDESC="DAY SURG AUDIT"
+1 SET ZTSAVE("DGBDT")=""
SET ZTSAVE("DGEDT")=""
SET ZTSAVE("DGOPT(")=""
+2 DO ^%ZTLOAD
DO ^%ZISC
KILL ZTSK
END KILL Y,DGBDT,DGEDT
DO HOME^%ZIS
QUIT
+1 ;
+2 ;
CALC ;***> set up sorted Utility file for date range
+1 ;***> loop thru file by surgery date
+2 SET DGDT=DGBDT-.0001
SET DGEDT=DGEDT+.2400
KILL ^TMP("DGDSAU",$JOB)
+3 ;IHS/DSD/ENM 06/19/2000
SET DGX=DGDT
C1 SET DGDT=$ORDER(^ADGDS("AA",DGDT))
IF DGDT=""
GOTO NEXT
IF DGDT>DGEDT
GOTO NEXT
SET DFN=0
C2 SET DFN=$ORDER(^ADGDS("AA",DGDT,DFN))
IF DFN=""
GOTO C1
SET DGDFN1=0
C3 SET DGDFN1=$ORDER(^ADGDS("AA",DGDT,DFN,DGDFN1))
IF DGDFN1=""
GOTO C2
+1 ;
+2 IF '$DATA(^ADGDS(DFN,0))
GOTO C3
IF '$DATA(^ADGDS(DFN,"DS",DGDFN1,0))
GOTO C3
SET DGSTR=^(0)
+3 SET (AGE,DGPRC,DGSRV,DGOBS,DGADM,DGADWK,DGCAN,DGUNES,DGNM,DGNS,DGCMT)=""
+4 ;patient name
SET DGNM=$PIECE(^DPT(DFN,0),U)
+5 ;chrt
SET DGCHT=$SELECT($DATA(^AUPNPAT(DFN,41,DUZ(2),0)):$PIECE(^(0),U,2),1:"??")
+6 SET AGE=$$VAL^XBDIQ1(9000001,DFN,1102.99)
+7 ;procedure/service
SET DGPRC=$PIECE(DGSTR,U,2)
SET DGSRV=$PIECE(DGSTR,U,5)
+8 ;length of stay
SET DGLOS=$$VAL^XBDIQ1(9009012.01,"DFN,DGDFN1",8)
+9 ;los in observ
SET DGOBS=$$VAL^XBDIQ1(9009012.01,"DFN,DGDFN1",10)
+10 ;srv
IF DGSRV'=""
SET DGSRV=$SELECT($DATA(^DIC(45.7,DGSRV,0)):$PIECE(^(0),U),1:DGSRV)
+11 ;admitted?
SET DGSTR2=$GET(^ADGDS(DFN,"DS",DGDFN1,2))
SET DGADM=$PIECE(DGSTR2,U,2)
+12 ;cancel?/no-show?
SET DGCAN=$PIECE(DGSTR2,U,3)
SET DGNS=$PIECE(DGSTR2,U,4)
+13 ;unescorted?/comments
SET DGUNES=$PIECE(DGSTR2,U,5)
SET DGCMT=$PIECE(DGSTR2,U,6)
+14 ;no admission found
IF DGADM'="Y"
GOTO C4
SET X=DGDT-.0001
SET DGADM="??"
+15 ;
+16 ;***> find if patient admitted w/in time limit for day surgery
+17 SET DGREL=$SELECT($DATA(DGSTR2):$PIECE(DGSTR2,U),1:"")
+18 SET DGX1=$SELECT(DGREL'="":DGREL,1:DGDT)
+19 FOR
SET DGX=$ORDER(^DGPM("AMV1",DGX))
IF DGX=""
QUIT
IF DGX>(DGX1+1)
QUIT
IF $DATA(^DGPM("AMV1",DGX,DFN))
SET DGY=$ORDER(^DGPM("AMV1",DGX,DFN,0))
SET DGADM=$PIECE(^DGPM(DGY,0),U)
QUIT
+20 GOTO C5
C4 SET Y=9999999-DGDT
SET X1=$PIECE(DGDT,".")
SET X2=$PIECE(DGOPT("QA1"),U,2)
DO C^%DTC
+1 SET DGX=9999999-X
SET DGX=$ORDER(^DGPM("ATID1",DGX))
+2 IF DGX'=""
IF DGX'>Y
SET DGADWK=9999999-DGX
+3 ;
+4 ;***> set utility file to sort by date, service, name
C5 SET ^TMP("DGDSAU",$JOB,$PIECE(DGDT,"."),DGSRV,DGNM,DFN,DGDFN1)=DGCHT_U_AGE_U_DGPRC_U_DGLOS_U_DGOBS_U_DGADM_U_DGADWK_U_DGCAN_U_DGUNES_U_DGNS_U_DGCMT
GOTO C3
+1 ;
NEXT GOTO ^ADGDSAU1
