- PXCEPAT ;ISL/dee,ISA/KWP - Creates the List Manager display of visit for a patient ; 6/3/03 10:47am ; Compiled January 5, 2007 14:12:43
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,5,14,30,70,147,160,161,183,188**;Aug 12, 1996;Build 3
- Q
- ;
- NEWPAT2 ;Entry point of changing patient from Update Encounter
- N PXCENEWP
- D PATIENT(.PXCENEWP)
- Q:PXCENEWP'>0
- D PATKILL
- S PXCEPAT=+PXCENEWP
- NEWPAT1 ;Entry point for initial selection of patient
- D PATINFO(.PXCEPAT) Q:$D(DIRUT)
- I $P(PXCEVIEW,"^",1)'="P" D
- . S $P(PXCEVIEW,"^",1)="P"
- . D SETDATES^PXCE
- S SDAMTYP="P"
- I PXCEVIEW["A" K PXCEHLOC
- Q
- ;
- NEWPAT ; -- init variables and list array
- N PXCENEWP
- D PATIENT(.PXCENEWP)
- I PXCENEWP'>0,("~H~P~"'[("~"_$P(PXCEVIEW,"^")_"~")) S VALMQUIT=1 Q
- I PXCENEWP'>0 Q
- D PATKILL
- S PXCEPAT=+PXCENEWP
- D NEWPAT1 Q:$D(DIRUT)
- D MAKELIST^PXCENEW
- Q
- ;
- MAKELIST ;
- N PXCEDATE,PXCELOC,PXCESTAT,PXCEDT,PXCEIEN,PXCEVSIT,PXCEPRIM
- D CHGCAP^VALM("LOCATION","Clinic")
- K VALMHDR S VALMBCK="R"
- S PXCEDT=PXCE9END
- D CLEAN^VALM10
- K ^TMP("PXCEIDX",$J)
- S VALMBG=1
- S VALMCNT=0
- F S PXCEDT=$O(^AUPNVSIT("AA",PXCEPAT,PXCEDT)) Q:PXCEDT'>0!(PXCEDT>PXCE9BEG) D
- . S PXCEIEN=""
- . F S PXCEIEN=$O(^AUPNVSIT("AA",PXCEPAT,PXCEDT,PXCEIEN)) Q:PXCEIEN'>0 D
- .. S PXCEVSIT=^AUPNVSIT(PXCEIEN,0)
- .. I $D(PXCEHLOC),$P(PXCEVSIT,"^",22)'=PXCEHLOC Q
- .. S PXCEPRIM=$P($G(^AUPNVSIT(PXCEIEN,150)),"^",3)
- .. ;+do not show encounter if the encounter type is S,C or null
- .. Q:"SC"[PXCEPRIM
- .. I PXCEKEYS'["S",PXCEKEYS'["V","A"=PXCEPRIM Q ;+let supervisor and viewer see ancillary encounters
- .. I PXCEKEYS'["V",$$DISPOSIT^PXUTL1(PXCEPAT,+PXCEVSIT,PXCEIEN) Q ;+let viewer see disposition
- .. S VALMCNT=VALMCNT+1
- .. S Y=$P(PXCEVSIT,"^",1)
- .. S PXCEDATE=$$DATE^PXCEDATE($P(PXCEVSIT,"^",1))
- .. S PXCEDATE=$E(PXCEDATE,1,18)_$J("",(19-$L(PXCEDATE)))
- .. I $P(PXCEVSIT,"^",7)="E" D
- ... S PXCELOC=" Historical Encounter at "
- ... I $P(PXCEVSIT,"^",6)]"" D
- .... N PXCEDELF
- .... S PXCESTAT=$E($$EXTERNAL^DILFD(9000010,.06,"",$P(PXCEVSIT,"^",6),"PXCEDILF"),1,30)
- ... E S PXCESTAT=$E($P($G(^AUPNVSIT(PXCEIEN,21)),"^"),1,30)
- .. E D
- ... S PXCELOC=$S($P(PXCEVSIT,"^",22)>0:$P(^SC($P(PXCEVSIT,"^",22),0),"^"),$P(PXCEVSIT,"^",7)="E":" Historical",1:"")
- ... S PXCELOC=$E(PXCELOC,1,26)_$J("",(28-$L(PXCELOC)))
- ... S PXCESTAT=$P($$STATUS^SDPCE(PXCEIEN),"^",2)
- .. S ^TMP("PXCE",$J,VALMCNT,0)=$J(VALMCNT,4)_" "_PXCEDATE_PXCELOC_PXCESTAT
- .. S ^TMP("PXCEIDX",$J,VALMCNT)=PXCEIEN
- S ^TMP("PXCEIDX",$J,0)=VALMCNT
- I VALMCNT'>0 D
- . S ^TMP("PXCE",$J,1,0)=" "
- . S ^TMP("PXCE",$J,2,0)=" No encounter found that satisfy the above criteria."
- . S VALMCNT=2
- Q
- ;
- SDSALONE ;Get the patient for standalone from the appointment/hospital
- ;location screen
- Q:$G(PXCEPAT)>0
- D PATIENT(.PXCEPAT)
- I PXCEPAT>0 D PATINFO(.PXCEPAT) S PXCEJPAT=1
- Q
- ;
- SDKALONE ;Kill the patient info if it was created above
- Q:'$D(PXCEJPAT)
- D PATKILL
- K PXCEJPAT
- Q
- ;
- JUSTDFN ;Just set DFN for other packages.
- Q
- Q:$G(DFN)>0
- N X,Y,DIC,DA
- S DIC=2,DIC(0)="AEMQ"
- D ^DIC
- I +Y>0 S DFN=+Y,PXCEJDFN=1
- Q
- ;
- JUSTDFNK ;Kill DFN if it was set above
- I $G(PXCEJDFN) K DFN,PXCEJDFN
- I $G(PXCEPAT)>0 S DFN=PXCEPAT
- Q
- ;
- PATIENT(PXCEDATA) ; Select a patient
- N X,Y,DIC,DA,DFN
- D FULL^VALM1
- S DIC=2,DIC(0)="AEMQ" D ^DIC
- S PXCEDATA=+Y
- PAT1 S %=1 I Y>0 W !," ...OK" D YN^DICN I %=0 W " Answer With 'Yes' or 'No'" G PAT1
- I %'=1!$D(DIRUT) S (Y,PXCEDATA)=-1
- I +Y'>0 D Q
- . I $G(DFN)'>0 S VALMSG=$C(7)_"Patient has not been selected." W !!,$G(VALMSG) H 1
- I +Y>0 S DFN=+Y D 2^VADPT I +VADM(6) N DIR D I $D(DIRUT) S PXCEDATA=-1
- . S DIR(0)="E",DIR("A")="Enter RETURN to continue or '^' to exit"
- . S DIR("A",1)="WARNING "_VADM(7) D ^DIR
- Q
- ;
- PATINFO(PXCEDATA) ;
- Q:$G(PXCEDATA)'>0
- S (DFN,SDFN,ORVP)=PXCEDATA
- D:$G(PXCECAT)="SIT"!($G(PXCECAT)="HIST")!($G(PXCECAT)="AEP")!$G(FSEL) DTHINFO
- I $D(DIRUT),$G(FSEL) D PATKILL Q
- ;D 2^VADPT I +VADM(6) D K DIR I $D(DIRUT) D:$G(PXCECAT)'="SIT"&($G(PXCECAT)'="HIST")&($G(PXCECAT)'="AEP") PATKILL Q
- ;. S DIR(0)="E",DIR("A")="Enter RETURN to continue or '^' to Quit"
- ;. S DIR("A",2)="WARNING "_VADM(7),DIR("A",1)=" ",DIR("A",3)=" " D ^DIR
- N Y
- S Y=PXCEDATA
- ;Set IHS patient variables
- D START^AUPNPAT
- D PATNAME(.PXCEDATA)
- N VAERR,VAROOT,PXCEVA,PXCEINDX
- S VAROOT="PXCEVA"
- D ELIG^VADPT
- S PXCEDATA("ELIG")=$P($G(PXCEVA(1)),"^",1,99)
- S PXCEINDX=""
- F S PXCEINDX=$O(PXCEVA(1,PXCEINDX)) Q:'PXCEINDX S PXCEDATA("ELIG",PXCEINDX)=$P(PXCEVA(1,PXCEINDX),"^",1,99)
- Q
- ;
- DTHINFO ;DEATH WARNING
- D 2^VADPT N DIR I +VADM(6) D
- . S DIR(0)="E",DIR("A")="Enter RETURN to continue or '^' to Quit"
- . S DIR("A",2)="WARNING "_VADM(7),DIR("A",1)=" ",DIR("A",3)=" " D ^DIR
- Q
- PATNAME(PXCEDATA) ;
- S PXCEDATA("NAME")=$P($G(^DPT(+PXCEDATA,0)),"^",1)
- N VAPTYP,VA,VAERR,DFN
- S DFN=+PXCEDATA
- D PID^VADPT6
- I 'VAERR S PXCEDATA("SSN")=VA("PID"),PXCEDATA("SSN_BRIEF")=VA("BID")
- E S (PXCEDATA("SSN"),PXCEDATA("SSN_BRIEF"))=""
- Q
- ;
- PATKILL ;
- K PXCEPAT,DFN,SDFN,ORVP,VADM,VAEL,VALMSG
- ; Kill IHS patient variables
- D KILL^AUPNPAT
- Q
- ;
- APPOINT(DFN,DATETIME,HOSLOC) ;See if there is an appointment.
- ;Input:
- ; DFN ien of the patient
- ; DATETIME the date and time of the appointment
- ; HOSLOC optional, is the Hospital Location (#44)
- ;Returns the clinic ien or -1 if no appointement.
- ;
- N VASD,HL,INDEX,VAERR
- K ^UTILITY("VASD",$J)
- S VASD("T")=DATETIME
- S VASD("F")=DATETIME-.00000001
- S VASD("W")=129 ;1)Active/Kept 2)Inpatient appts. only 9)No action taken
- S:$G(HOSLOC) VASD("C",HOSLOC)=""
- D SDA^VADPT
- I VAERR S HL=-1 G QAPPOINT
- S INDEX=$O(^UTILITY("VASD",$J,0))
- I INDEX>0 S HL=$P(^UTILITY("VASD",$J,INDEX,"I"),"^",2)
- E S HL=-1
- QAPPOINT K ^UTILITY("VASD",$J)
- Q HL
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCEPAT 5810 printed Jan 18, 2025@03:29:09 Page 2
- PXCEPAT ;ISL/dee,ISA/KWP - Creates the List Manager display of visit for a patient ; 6/3/03 10:47am ; Compiled January 5, 2007 14:12:43
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,5,14,30,70,147,160,161,183,188**;Aug 12, 1996;Build 3
- +2 QUIT
- +3 ;
- NEWPAT2 ;Entry point of changing patient from Update Encounter
- +1 NEW PXCENEWP
- +2 DO PATIENT(.PXCENEWP)
- +3 if PXCENEWP'>0
- QUIT
- +4 DO PATKILL
- +5 SET PXCEPAT=+PXCENEWP
- NEWPAT1 ;Entry point for initial selection of patient
- +1 DO PATINFO(.PXCEPAT)
- if $DATA(DIRUT)
- QUIT
- +2 IF $PIECE(PXCEVIEW,"^",1)'="P"
- Begin DoDot:1
- +3 SET $PIECE(PXCEVIEW,"^",1)="P"
- +4 DO SETDATES^PXCE
- End DoDot:1
- +5 SET SDAMTYP="P"
- +6 IF PXCEVIEW["A"
- KILL PXCEHLOC
- +7 QUIT
- +8 ;
- NEWPAT ; -- init variables and list array
- +1 NEW PXCENEWP
- +2 DO PATIENT(.PXCENEWP)
- +3 IF PXCENEWP'>0
- IF ("~H~P~"'[("~"_$PIECE(PXCEVIEW,"^")_"~"))
- SET VALMQUIT=1
- QUIT
- +4 IF PXCENEWP'>0
- QUIT
- +5 DO PATKILL
- +6 SET PXCEPAT=+PXCENEWP
- +7 DO NEWPAT1
- if $DATA(DIRUT)
- QUIT
- +8 DO MAKELIST^PXCENEW
- +9 QUIT
- +10 ;
- MAKELIST ;
- +1 NEW PXCEDATE,PXCELOC,PXCESTAT,PXCEDT,PXCEIEN,PXCEVSIT,PXCEPRIM
- +2 DO CHGCAP^VALM("LOCATION","Clinic")
- +3 KILL VALMHDR
- SET VALMBCK="R"
- +4 SET PXCEDT=PXCE9END
- +5 DO CLEAN^VALM10
- +6 KILL ^TMP("PXCEIDX",$JOB)
- +7 SET VALMBG=1
- +8 SET VALMCNT=0
- +9 FOR
- SET PXCEDT=$ORDER(^AUPNVSIT("AA",PXCEPAT,PXCEDT))
- if PXCEDT'>0!(PXCEDT>PXCE9BEG)
- QUIT
- Begin DoDot:1
- +10 SET PXCEIEN=""
- +11 FOR
- SET PXCEIEN=$ORDER(^AUPNVSIT("AA",PXCEPAT,PXCEDT,PXCEIEN))
- if PXCEIEN'>0
- QUIT
- Begin DoDot:2
- +12 SET PXCEVSIT=^AUPNVSIT(PXCEIEN,0)
- +13 IF $DATA(PXCEHLOC)
- IF $PIECE(PXCEVSIT,"^",22)'=PXCEHLOC
- QUIT
- +14 SET PXCEPRIM=$PIECE($GET(^AUPNVSIT(PXCEIEN,150)),"^",3)
- +15 ;+do not show encounter if the encounter type is S,C or null
- +16 if "SC"[PXCEPRIM
- QUIT
- +17 ;+let supervisor and viewer see ancillary encounters
- IF PXCEKEYS'["S"
- IF PXCEKEYS'["V"
- IF "A"=PXCEPRIM
- QUIT
- +18 ;+let viewer see disposition
- IF PXCEKEYS'["V"
- IF $$DISPOSIT^PXUTL1(PXCEPAT,+PXCEVSIT,PXCEIEN)
- QUIT
- +19 SET VALMCNT=VALMCNT+1
- +20 SET Y=$PIECE(PXCEVSIT,"^",1)
- +21 SET PXCEDATE=$$DATE^PXCEDATE($PIECE(PXCEVSIT,"^",1))
- +22 SET PXCEDATE=$EXTRACT(PXCEDATE,1,18)_$JUSTIFY("",(19-$LENGTH(PXCEDATE)))
- +23 IF $PIECE(PXCEVSIT,"^",7)="E"
- Begin DoDot:3
- +24 SET PXCELOC=" Historical Encounter at "
- +25 IF $PIECE(PXCEVSIT,"^",6)]""
- Begin DoDot:4
- +26 NEW PXCEDELF
- +27 SET PXCESTAT=$EXTRACT($$EXTERNAL^DILFD(9000010,.06,"",$PIECE(PXCEVSIT,"^",6),"PXCEDILF"),1,30)
- End DoDot:4
- +28 IF '$TEST
- SET PXCESTAT=$EXTRACT($PIECE($GET(^AUPNVSIT(PXCEIEN,21)),"^"),1,30)
- End DoDot:3
- +29 IF '$TEST
- Begin DoDot:3
- +30 SET PXCELOC=$SELECT($PIECE(PXCEVSIT,"^",22)>0:$PIECE(^SC($PIECE(PXCEVSIT,"^",22),0),"^"),$PIECE(PXCEVSIT,"^",7)="E":" Historical",1:"")
- +31 SET PXCELOC=$EXTRACT(PXCELOC,1,26)_$JUSTIFY("",(28-$LENGTH(PXCELOC)))
- +32 SET PXCESTAT=$PIECE($$STATUS^SDPCE(PXCEIEN),"^",2)
- End DoDot:3
- +33 SET ^TMP("PXCE",$JOB,VALMCNT,0)=$JUSTIFY(VALMCNT,4)_" "_PXCEDATE_PXCELOC_PXCESTAT
- +34 SET ^TMP("PXCEIDX",$JOB,VALMCNT)=PXCEIEN
- End DoDot:2
- End DoDot:1
- +35 SET ^TMP("PXCEIDX",$JOB,0)=VALMCNT
- +36 IF VALMCNT'>0
- Begin DoDot:1
- +37 SET ^TMP("PXCE",$JOB,1,0)=" "
- +38 SET ^TMP("PXCE",$JOB,2,0)=" No encounter found that satisfy the above criteria."
- +39 SET VALMCNT=2
- End DoDot:1
- +40 QUIT
- +41 ;
- SDSALONE ;Get the patient for standalone from the appointment/hospital
- +1 ;location screen
- +2 if $GET(PXCEPAT)>0
- QUIT
- +3 DO PATIENT(.PXCEPAT)
- +4 IF PXCEPAT>0
- DO PATINFO(.PXCEPAT)
- SET PXCEJPAT=1
- +5 QUIT
- +6 ;
- SDKALONE ;Kill the patient info if it was created above
- +1 if '$DATA(PXCEJPAT)
- QUIT
- +2 DO PATKILL
- +3 KILL PXCEJPAT
- +4 QUIT
- +5 ;
- JUSTDFN ;Just set DFN for other packages.
- +1 QUIT
- +2 if $GET(DFN)>0
- QUIT
- +3 NEW X,Y,DIC,DA
- +4 SET DIC=2
- SET DIC(0)="AEMQ"
- +5 DO ^DIC
- +6 IF +Y>0
- SET DFN=+Y
- SET PXCEJDFN=1
- +7 QUIT
- +8 ;
- JUSTDFNK ;Kill DFN if it was set above
- +1 IF $GET(PXCEJDFN)
- KILL DFN,PXCEJDFN
- +2 IF $GET(PXCEPAT)>0
- SET DFN=PXCEPAT
- +3 QUIT
- +4 ;
- PATIENT(PXCEDATA) ; Select a patient
- +1 NEW X,Y,DIC,DA,DFN
- +2 DO FULL^VALM1
- +3 SET DIC=2
- SET DIC(0)="AEMQ"
- DO ^DIC
- +4 SET PXCEDATA=+Y
- PAT1 SET %=1
- IF Y>0
- WRITE !," ...OK"
- DO YN^DICN
- IF %=0
- WRITE " Answer With 'Yes' or 'No'"
- GOTO PAT1
- +1 IF %'=1!$DATA(DIRUT)
- SET (Y,PXCEDATA)=-1
- +2 IF +Y'>0
- Begin DoDot:1
- +3 IF $GET(DFN)'>0
- SET VALMSG=$CHAR(7)_"Patient has not been selected."
- WRITE !!,$GET(VALMSG)
- HANG 1
- End DoDot:1
- QUIT
- +4 IF +Y>0
- SET DFN=+Y
- DO 2^VADPT
- IF +VADM(6)
- NEW DIR
- Begin DoDot:1
- +5 SET DIR(0)="E"
- SET DIR("A")="Enter RETURN to continue or '^' to exit"
- +6 SET DIR("A",1)="WARNING "_VADM(7)
- DO ^DIR
- End DoDot:1
- IF $DATA(DIRUT)
- SET PXCEDATA=-1
- +7 QUIT
- +8 ;
- PATINFO(PXCEDATA) ;
- +1 if $GET(PXCEDATA)'>0
- QUIT
- +2 SET (DFN,SDFN,ORVP)=PXCEDATA
- +3 if $GET(PXCECAT)="SIT"!($GET(PXCECAT)="HIST")!($GET(PXCECAT)="AEP")!$GET(FSEL)
- DO DTHINFO
- +4 IF $DATA(DIRUT)
- IF $GET(FSEL)
- DO PATKILL
- QUIT
- +5 ;D 2^VADPT I +VADM(6) D K DIR I $D(DIRUT) D:$G(PXCECAT)'="SIT"&($G(PXCECAT)'="HIST")&($G(PXCECAT)'="AEP") PATKILL Q
- +6 ;. S DIR(0)="E",DIR("A")="Enter RETURN to continue or '^' to Quit"
- +7 ;. S DIR("A",2)="WARNING "_VADM(7),DIR("A",1)=" ",DIR("A",3)=" " D ^DIR
- +8 NEW Y
- +9 SET Y=PXCEDATA
- +10 ;Set IHS patient variables
- +11 DO START^AUPNPAT
- +12 DO PATNAME(.PXCEDATA)
- +13 NEW VAERR,VAROOT,PXCEVA,PXCEINDX
- +14 SET VAROOT="PXCEVA"
- +15 DO ELIG^VADPT
- +16 SET PXCEDATA("ELIG")=$PIECE($GET(PXCEVA(1)),"^",1,99)
- +17 SET PXCEINDX=""
- +18 FOR
- SET PXCEINDX=$ORDER(PXCEVA(1,PXCEINDX))
- if 'PXCEINDX
- QUIT
- SET PXCEDATA("ELIG",PXCEINDX)=$PIECE(PXCEVA(1,PXCEINDX),"^",1,99)
- +19 QUIT
- +20 ;
- DTHINFO ;DEATH WARNING
- +1 DO 2^VADPT
- NEW DIR
- IF +VADM(6)
- Begin DoDot:1
- +2 SET DIR(0)="E"
- SET DIR("A")="Enter RETURN to continue or '^' to Quit"
- +3 SET DIR("A",2)="WARNING "_VADM(7)
- SET DIR("A",1)=" "
- SET DIR("A",3)=" "
- DO ^DIR
- End DoDot:1
- +4 QUIT
- PATNAME(PXCEDATA) ;
- +1 SET PXCEDATA("NAME")=$PIECE($GET(^DPT(+PXCEDATA,0)),"^",1)
- +2 NEW VAPTYP,VA,VAERR,DFN
- +3 SET DFN=+PXCEDATA
- +4 DO PID^VADPT6
- +5 IF 'VAERR
- SET PXCEDATA("SSN")=VA("PID")
- SET PXCEDATA("SSN_BRIEF")=VA("BID")
- +6 IF '$TEST
- SET (PXCEDATA("SSN"),PXCEDATA("SSN_BRIEF"))=""
- +7 QUIT
- +8 ;
- PATKILL ;
- +1 KILL PXCEPAT,DFN,SDFN,ORVP,VADM,VAEL,VALMSG
- +2 ; Kill IHS patient variables
- +3 DO KILL^AUPNPAT
- +4 QUIT
- +5 ;
- APPOINT(DFN,DATETIME,HOSLOC) ;See if there is an appointment.
- +1 ;Input:
- +2 ; DFN ien of the patient
- +3 ; DATETIME the date and time of the appointment
- +4 ; HOSLOC optional, is the Hospital Location (#44)
- +5 ;Returns the clinic ien or -1 if no appointement.
- +6 ;
- +7 NEW VASD,HL,INDEX,VAERR
- +8 KILL ^UTILITY("VASD",$JOB)
- +9 SET VASD("T")=DATETIME
- +10 SET VASD("F")=DATETIME-.00000001
- +11 ;1)Active/Kept 2)Inpatient appts. only 9)No action taken
- SET VASD("W")=129
- +12 if $GET(HOSLOC)
- SET VASD("C",HOSLOC)=""
- +13 DO SDA^VADPT
- +14 IF VAERR
- SET HL=-1
- GOTO QAPPOINT
- +15 SET INDEX=$ORDER(^UTILITY("VASD",$JOB,0))
- +16 IF INDEX>0
- SET HL=$PIECE(^UTILITY("VASD",$JOB,INDEX,"I"),"^",2)
- +17 IF '$TEST
- SET HL=-1
- QAPPOINT KILL ^UTILITY("VASD",$JOB)
- +1 QUIT HL
- +2 ;