- 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
