- ADGPI ; IHS/ADC/PDW/ENM - PATIENT INQUIRY ; [ 09/17/2002 4:19 PM ]
- ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- ;
- SP ; -- select patient
- N DFN,DIC,Y,X S DIC="^DPT(",DIC(0)="AEQMZ"
- D ^DIC K DIC Q:Y'>0 S DFN=+Y D EN G SP
- ;
- EN ;EP; entry point - input DFN
- Q:'$D(DFN) D DM,CS,DS,SV,FA,KVA^VADPT,IN,PG Q
- ;
- DM ; -- demographic data
- N DGDPTN0,DGDPTN11,DGDPTN13,DGPATN0,DGPATN11
- S DGDPTN0=^DPT(DFN,0),DGDPTN11=$G(^(.11)),DGDPTN13=$G(^(.13))
- S DGPATN0=$G(^AUPNPAT(DFN,0)),DGPATN11=$G(^(11))
- W !!?13,"***Confidential Patient Data Covered by Privacy Act***"
- W !!,$P(DGDPTN0,U),?32,"HRCN: ",$$HRCN^ADGF,?54,"DOB: ",$$DOB
- W !,$P(DGDPTN11,U),?31,"PHONE: ",$P(DGDPTN13,U),?53,"PROV: ",$$PCP
- W !,$P(DGDPTN11,U,4)," ",$$ST," ",$P(DGDPTN11,U,6)
- W ?32,"ELIG: ",$$ELIG,?54,"SSN: ",$P(DGDPTN0,U,9) Q
- ;
- CS ; -- current status
- ;D INP^DGRPD Q
- D INP^ADGRPD Q ;9/17/02 WAR Modified to allow for v5.3 DaySurgery
- ;
- DS ; -- last day surgery
- S X="SRZPEP" X ^%ZOSF("TEST") I $T S DGCK=$$LASTDS^SRZPEP
- Q:$G(DGCK)
- Q:'$D(^ADGDS(DFN)) N X,Y,DGDSN0,DGDSN2 S (X,Y)=0
- F S X=$O(^ADGDS(DFN,"DS","AA",X)) Q:'X S Y=X
- Q:'Y S X=$O(^ADGDS(DFN,"DS","AA",Y,0)) Q:'X
- Q:'$D(^ADGDS(DFN,"DS",X,0)) S DS=X,DGDSN0=^(0),DGDSN2=$G(^(2))
- W !!,"DAY SURGERY date: ",$$DSDT
- W:DGDSN2 ?38,"Released: ",$$DSRL," LOS: ",$$DSLS
- I $P(DGDSN2,U,3)="Y" W ?38,"**CANCELLED**"
- I $P(DGDSN2,U,4)="Y" W ?38,"**NO-SHOW**"
- W !?9,"Service: ",$$DSSV,?38,"Provider: ",$$DSPR Q
- ;
- SV ; -- scheduled visit
- Q:'$D(^ADGAUTH(DFN,1,0)) N X,Y,DGSVN0 S (X,Y)=0
- F S X=$O(^ADGAUTH(DFN,1,X)) Q:'X D
- . S DGSVN0=^ADGAUTH(DFN,1,X,0)
- . Q:$P(DGSVN0,U,5)=""!("IQD"'[$P(DGSVN0,U,5))
- . D @("SV"_$P(DGSVN0,U,5))
- Q
- ;
- SVI ; -- scheduled admit
- N X S X=+DGSVN0
- W !!?10,"Scheduled Admit for ",$E(X,4,5),"/",$E(X,6,7),"/",$E(X,2,3)
- S X=$P(DGSVN0,U,7) W:X ?43,"Ward: ",$E($P($G(^DIC(42,+X,0)),U),1,3)
- S X=$P(DGSVN0,U,3) W:X ?55,"Service: ",$P($G(^DIC(45.7,+X,0)),U,3) Q
- ;
- SVQ ; -- scheduled quarters
- N X S X=+DGSVN0 W !!?10,"Scheduled for Quarters on "
- W $E(X,4,5),"/",$E(X,6,7),"/",$E(X,2,3) S X=$P(DGSVN0,U,2)
- W ?50,"Provider: " W:X $E($P($G(^DIC(45.7,+X,0)),U,3),1,20) Q
- ;
- SVD ; -- scheduled day surgery
- N X S X=+DGSVN0 W !!?10,"Scheduled for Day Surgery on "
- W $E(X,4,5),"/",$E(X,6,7),"/",$E(X,2,3)
- S X=$P(DGSVN0,U,3) W:X " Service: ",$P(^DIC(45.7,X,0),U,3) Q
- ;
- FA ; -- scheduled future appointments
- ;9/17/02 WAR Chgd to accomodate v5.3 DaySurgery
- ;D FA^DGRPD Q
- D FA^ADGRPD Q
- ;
- IN ; -- insurance (from health summary)
- ;N APCHSPAT,APCHSCKP,APCHSNPG,APCHSCVD,APCHSBRK,APCHSQ
- S APCHSPAT=DFN,APCHSCKP="",APCHSNPG=0,APCHSBRK=""
- S APCHSCVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$E(Y,6,7)_""/""_$E(Y,2,3)"
- W !! D ^APCHS5 Q
- ;
- PG ; -- page
- N X,Y K DIR S DIR(0)="E" D ^DIR K DIR,X Q
- ;
- DOB() ; -- date of birth
- N Y S Y=$P(DGDPTN0,U,3) X ^DD("DD") Q Y
- ;
- ELIG() ; -- eligibility status
- N Y,C S Y=$P(DGPATN11,U,12) S C=$P(^DD(9000001,1112,0),U,2)
- D Y^DIQ Q $E(Y,1,13)
- ;
- ST() ; -- state
- Q $P($G(^DIC(5,+$P(DGDPTN11,U,5),0)),U,2)
- ;
- DSDT() ; -- day surgery date/time
- N Y S Y=+DGDSN0 X ^DD("DD") Q Y
- ;
- DSSV() ; -- day surgery treating specialty
- Q $E($P($G(^DIC(45.7,+$P(DGDSN0,U,5),0)),U),1,20)
- ;
- DSPR() ; -- day surgery provider
- Q $E($P($G(^VA(200,+$P(DGDSN0,U,6),0)),U),1,20)
- ;
- DSRL() ; -- day surgery release date/time
- N Y S Y=+DGDSN2 X ^DD("DD") Q Y
- ;
- DSLS() ; -- day surgery length of stay
- Q:'DS "" D Q X_" hrs"
- . K ^UTILITY("DIQ1",$J) S DR(9009012.01)=8,DA(9009012.01)=DS
- . S DIC=9009012,DA=DFN,DR=1 D EN^DIQ1
- . S X=$G(^UTILITY("DIQ1",$J,9009012.01,DS,8))
- . K ^UTILITY("DIQ1",$J),DIC,DA,DR
- ;
- PCP() ; -- primary care provider
- I $P(^DD(9000001,.14,0),U,2)["200" Q $E($P($G(^VA(200,+$P(^AUPNPAT(DFN,0),U,14),0)),U),1,20)
- Q $E($P($G(^DIC(16,+$P(^AUPNPAT(DFN,0),U,14),0)),U),1,20)
- ADGPI ; IHS/ADC/PDW/ENM - PATIENT INQUIRY ; [ 09/17/2002 4:19 PM ]
- +1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- +2 ;
- SP ; -- select patient
- +1 NEW DFN,DIC,Y,X
- SET DIC="^DPT("
- SET DIC(0)="AEQMZ"
- +2 DO ^DIC
- KILL DIC
- IF Y'>0
- QUIT
- SET DFN=+Y
- DO EN
- GOTO SP
- +3 ;
- EN ;EP; entry point - input DFN
- +1 IF '$DATA(DFN)
- QUIT
- DO DM
- DO CS
- DO DS
- DO SV
- DO FA
- DO KVA^VADPT
- DO IN
- DO PG
- QUIT
- +2 ;
- DM ; -- demographic data
- +1 NEW DGDPTN0,DGDPTN11,DGDPTN13,DGPATN0,DGPATN11
- +2 SET DGDPTN0=^DPT(DFN,0)
- SET DGDPTN11=$GET(^(.11))
- SET DGDPTN13=$GET(^(.13))
- +3 SET DGPATN0=$GET(^AUPNPAT(DFN,0))
- SET DGPATN11=$GET(^(11))
- +4 WRITE !!?13,"***Confidential Patient Data Covered by Privacy Act***"
- +5 WRITE !!,$PIECE(DGDPTN0,U),?32,"HRCN: ",$$HRCN^ADGF,?54,"DOB: ",$$DOB
- +6 WRITE !,$PIECE(DGDPTN11,U),?31,"PHONE: ",$PIECE(DGDPTN13,U),?53,"PROV: ",$$PCP
- +7 WRITE !,$PIECE(DGDPTN11,U,4)," ",$$ST," ",$PIECE(DGDPTN11,U,6)
- +8 WRITE ?32,"ELIG: ",$$ELIG,?54,"SSN: ",$PIECE(DGDPTN0,U,9)
- QUIT
- +9 ;
- CS ; -- current status
- +1 ;D INP^DGRPD Q
- +2 ;9/17/02 WAR Modified to allow for v5.3 DaySurgery
- DO INP^ADGRPD
- QUIT
- +3 ;
- DS ; -- last day surgery
- +1 SET X="SRZPEP"
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- SET DGCK=$$LASTDS^SRZPEP
- +2 IF $GET(DGCK)
- QUIT
- +3 IF '$DATA(^ADGDS(DFN))
- QUIT
- NEW X,Y,DGDSN0,DGDSN2
- SET (X,Y)=0
- +4 FOR
- SET X=$ORDER(^ADGDS(DFN,"DS","AA",X))
- IF 'X
- QUIT
- SET Y=X
- +5 IF 'Y
- QUIT
- SET X=$ORDER(^ADGDS(DFN,"DS","AA",Y,0))
- IF 'X
- QUIT
- +6 IF '$DATA(^ADGDS(DFN,"DS",X,0))
- QUIT
- SET DS=X
- SET DGDSN0=^(0)
- SET DGDSN2=$GET(^(2))
- +7 WRITE !!,"DAY SURGERY date: ",$$DSDT
- +8 IF DGDSN2
- WRITE ?38,"Released: ",$$DSRL," LOS: ",$$DSLS
- +9 IF $PIECE(DGDSN2,U,3)="Y"
- WRITE ?38,"**CANCELLED**"
- +10 IF $PIECE(DGDSN2,U,4)="Y"
- WRITE ?38,"**NO-SHOW**"
- +11 WRITE !?9,"Service: ",$$DSSV,?38,"Provider: ",$$DSPR
- QUIT
- +12 ;
- SV ; -- scheduled visit
- +1 IF '$DATA(^ADGAUTH(DFN,1,0))
- QUIT
- NEW X,Y,DGSVN0
- SET (X,Y)=0
- +2 FOR
- SET X=$ORDER(^ADGAUTH(DFN,1,X))
- IF 'X
- QUIT
- Begin DoDot:1
- +3 SET DGSVN0=^ADGAUTH(DFN,1,X,0)
- +4 IF $PIECE(DGSVN0,U,5)=""!("IQD"'[$PIECE(DGSVN0,U,5))
- QUIT
- +5 DO @("SV"_$PIECE(DGSVN0,U,5))
- End DoDot:1
- +6 QUIT
- +7 ;
- SVI ; -- scheduled admit
- +1 NEW X
- SET X=+DGSVN0
- +2 WRITE !!?10,"Scheduled Admit for ",$EXTRACT(X,4,5),"/",$EXTRACT(X,6,7),"/",$EXTRACT(X,2,3)
- +3 SET X=$PIECE(DGSVN0,U,7)
- IF X
- WRITE ?43,"Ward: ",$EXTRACT($PIECE($GET(^DIC(42,+X,0)),U),1,3)
- +4 SET X=$PIECE(DGSVN0,U,3)
- IF X
- WRITE ?55,"Service: ",$PIECE($GET(^DIC(45.7,+X,0)),U,3)
- QUIT
- +5 ;
- SVQ ; -- scheduled quarters
- +1 NEW X
- SET X=+DGSVN0
- WRITE !!?10,"Scheduled for Quarters on "
- +2 WRITE $EXTRACT(X,4,5),"/",$EXTRACT(X,6,7),"/",$EXTRACT(X,2,3)
- SET X=$PIECE(DGSVN0,U,2)
- +3 WRITE ?50,"Provider: "
- IF X
- WRITE $EXTRACT($PIECE($GET(^DIC(45.7,+X,0)),U,3),1,20)
- QUIT
- +4 ;
- SVD ; -- scheduled day surgery
- +1 NEW X
- SET X=+DGSVN0
- WRITE !!?10,"Scheduled for Day Surgery on "
- +2 WRITE $EXTRACT(X,4,5),"/",$EXTRACT(X,6,7),"/",$EXTRACT(X,2,3)
- +3 SET X=$PIECE(DGSVN0,U,3)
- IF X
- WRITE " Service: ",$PIECE(^DIC(45.7,X,0),U,3)
- QUIT
- +4 ;
- FA ; -- scheduled future appointments
- +1 ;9/17/02 WAR Chgd to accomodate v5.3 DaySurgery
- +2 ;D FA^DGRPD Q
- +3 DO FA^ADGRPD
- QUIT
- +4 ;
- IN ; -- insurance (from health summary)
- +1 ;N APCHSPAT,APCHSCKP,APCHSNPG,APCHSCVD,APCHSBRK,APCHSQ
- +2 SET APCHSPAT=DFN
- SET APCHSCKP=""
- SET APCHSNPG=0
- SET APCHSBRK=""
- +3 SET APCHSCVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$E(Y,6,7)_""/""_$E(Y,2,3)"
- +4 WRITE !!
- DO ^APCHS5
- QUIT
- +5 ;
- PG ; -- page
- +1 NEW X,Y
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR,X
- QUIT
- +2 ;
- DOB() ; -- date of birth
- +1 NEW Y
- SET Y=$PIECE(DGDPTN0,U,3)
- XECUTE ^DD("DD")
- QUIT Y
- +2 ;
- ELIG() ; -- eligibility status
- +1 NEW Y,C
- SET Y=$PIECE(DGPATN11,U,12)
- SET C=$PIECE(^DD(9000001,1112,0),U,2)
- +2 DO Y^DIQ
- QUIT $EXTRACT(Y,1,13)
- +3 ;
- ST() ; -- state
- +1 QUIT $PIECE($GET(^DIC(5,+$PIECE(DGDPTN11,U,5),0)),U,2)
- +2 ;
- DSDT() ; -- day surgery date/time
- +1 NEW Y
- SET Y=+DGDSN0
- XECUTE ^DD("DD")
- QUIT Y
- +2 ;
- DSSV() ; -- day surgery treating specialty
- +1 QUIT $EXTRACT($PIECE($GET(^DIC(45.7,+$PIECE(DGDSN0,U,5),0)),U),1,20)
- +2 ;
- DSPR() ; -- day surgery provider
- +1 QUIT $EXTRACT($PIECE($GET(^VA(200,+$PIECE(DGDSN0,U,6),0)),U),1,20)
- +2 ;
- DSRL() ; -- day surgery release date/time
- +1 NEW Y
- SET Y=+DGDSN2
- XECUTE ^DD("DD")
- QUIT Y
- +2 ;
- DSLS() ; -- day surgery length of stay
- +1 IF 'DS
- QUIT ""
- Begin DoDot:1
- +2 KILL ^UTILITY("DIQ1",$JOB)
- SET DR(9009012.01)=8
- SET DA(9009012.01)=DS
- +3 SET DIC=9009012
- SET DA=DFN
- SET DR=1
- DO EN^DIQ1
- +4 SET X=$GET(^UTILITY("DIQ1",$JOB,9009012.01,DS,8))
- +5 KILL ^UTILITY("DIQ1",$JOB),DIC,DA,DR
- End DoDot:1
- QUIT X_" hrs"
- +6 ;
- PCP() ; -- primary care provider
- +1 IF $PIECE(^DD(9000001,.14,0),U,2)["200"
- QUIT $EXTRACT($PIECE($GET(^VA(200,+$PIECE(^AUPNPAT(DFN,0),U,14),0)),U),1,20)
- +2 QUIT $EXTRACT($PIECE($GET(^DIC(16,+$PIECE(^AUPNPAT(DFN,0),U,14),0)),U),1,20)
