Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXCEPAT

PXCEPAT.m

Go to the documentation of this file.
  1. 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
  1. Q
  1. ;
  1. NEWPAT2 ;Entry point of changing patient from Update Encounter
  1. N PXCENEWP
  1. D PATIENT(.PXCENEWP)
  1. Q:PXCENEWP'>0
  1. D PATKILL
  1. S PXCEPAT=+PXCENEWP
  1. NEWPAT1 ;Entry point for initial selection of patient
  1. D PATINFO(.PXCEPAT) Q:$D(DIRUT)
  1. I $P(PXCEVIEW,"^",1)'="P" D
  1. . S $P(PXCEVIEW,"^",1)="P"
  1. . D SETDATES^PXCE
  1. S SDAMTYP="P"
  1. I PXCEVIEW["A" K PXCEHLOC
  1. Q
  1. ;
  1. NEWPAT ; -- init variables and list array
  1. N PXCENEWP
  1. D PATIENT(.PXCENEWP)
  1. I PXCENEWP'>0,("~H~P~"'[("~"_$P(PXCEVIEW,"^")_"~")) S VALMQUIT=1 Q
  1. I PXCENEWP'>0 Q
  1. D PATKILL
  1. S PXCEPAT=+PXCENEWP
  1. D NEWPAT1 Q:$D(DIRUT)
  1. D MAKELIST^PXCENEW
  1. Q
  1. ;
  1. MAKELIST ;
  1. N PXCEDATE,PXCELOC,PXCESTAT,PXCEDT,PXCEIEN,PXCEVSIT,PXCEPRIM
  1. D CHGCAP^VALM("LOCATION","Clinic")
  1. K VALMHDR S VALMBCK="R"
  1. S PXCEDT=PXCE9END
  1. D CLEAN^VALM10
  1. K ^TMP("PXCEIDX",$J)
  1. S VALMBG=1
  1. S VALMCNT=0
  1. F S PXCEDT=$O(^AUPNVSIT("AA",PXCEPAT,PXCEDT)) Q:PXCEDT'>0!(PXCEDT>PXCE9BEG) D
  1. . S PXCEIEN=""
  1. . F S PXCEIEN=$O(^AUPNVSIT("AA",PXCEPAT,PXCEDT,PXCEIEN)) Q:PXCEIEN'>0 D
  1. .. S PXCEVSIT=^AUPNVSIT(PXCEIEN,0)
  1. .. I $D(PXCEHLOC),$P(PXCEVSIT,"^",22)'=PXCEHLOC Q
  1. .. S PXCEPRIM=$P($G(^AUPNVSIT(PXCEIEN,150)),"^",3)
  1. .. ;+do not show encounter if the encounter type is S,C or null
  1. .. Q:"SC"[PXCEPRIM
  1. .. I PXCEKEYS'["S",PXCEKEYS'["V","A"=PXCEPRIM Q ;+let supervisor and viewer see ancillary encounters
  1. .. I PXCEKEYS'["V",$$DISPOSIT^PXUTL1(PXCEPAT,+PXCEVSIT,PXCEIEN) Q ;+let viewer see disposition
  1. .. S VALMCNT=VALMCNT+1
  1. .. S Y=$P(PXCEVSIT,"^",1)
  1. .. S PXCEDATE=$$DATE^PXCEDATE($P(PXCEVSIT,"^",1))
  1. .. S PXCEDATE=$E(PXCEDATE,1,18)_$J("",(19-$L(PXCEDATE)))
  1. .. I $P(PXCEVSIT,"^",7)="E" D
  1. ... S PXCELOC=" Historical Encounter at "
  1. ... I $P(PXCEVSIT,"^",6)]"" D
  1. .... N PXCEDELF
  1. .... S PXCESTAT=$E($$EXTERNAL^DILFD(9000010,.06,"",$P(PXCEVSIT,"^",6),"PXCEDILF"),1,30)
  1. ... E S PXCESTAT=$E($P($G(^AUPNVSIT(PXCEIEN,21)),"^"),1,30)
  1. .. E D
  1. ... S PXCELOC=$S($P(PXCEVSIT,"^",22)>0:$P(^SC($P(PXCEVSIT,"^",22),0),"^"),$P(PXCEVSIT,"^",7)="E":" Historical",1:"")
  1. ... S PXCELOC=$E(PXCELOC,1,26)_$J("",(28-$L(PXCELOC)))
  1. ... S PXCESTAT=$P($$STATUS^SDPCE(PXCEIEN),"^",2)
  1. .. S ^TMP("PXCE",$J,VALMCNT,0)=$J(VALMCNT,4)_" "_PXCEDATE_PXCELOC_PXCESTAT
  1. .. S ^TMP("PXCEIDX",$J,VALMCNT)=PXCEIEN
  1. S ^TMP("PXCEIDX",$J,0)=VALMCNT
  1. I VALMCNT'>0 D
  1. . S ^TMP("PXCE",$J,1,0)=" "
  1. . S ^TMP("PXCE",$J,2,0)=" No encounter found that satisfy the above criteria."
  1. . S VALMCNT=2
  1. Q
  1. ;
  1. SDSALONE ;Get the patient for standalone from the appointment/hospital
  1. ;location screen
  1. Q:$G(PXCEPAT)>0
  1. D PATIENT(.PXCEPAT)
  1. I PXCEPAT>0 D PATINFO(.PXCEPAT) S PXCEJPAT=1
  1. Q
  1. ;
  1. SDKALONE ;Kill the patient info if it was created above
  1. Q:'$D(PXCEJPAT)
  1. D PATKILL
  1. K PXCEJPAT
  1. Q
  1. ;
  1. JUSTDFN ;Just set DFN for other packages.
  1. Q
  1. Q:$G(DFN)>0
  1. N X,Y,DIC,DA
  1. S DIC=2,DIC(0)="AEMQ"
  1. D ^DIC
  1. I +Y>0 S DFN=+Y,PXCEJDFN=1
  1. Q
  1. ;
  1. JUSTDFNK ;Kill DFN if it was set above
  1. I $G(PXCEJDFN) K DFN,PXCEJDFN
  1. I $G(PXCEPAT)>0 S DFN=PXCEPAT
  1. Q
  1. ;
  1. PATIENT(PXCEDATA) ; Select a patient
  1. N X,Y,DIC,DA,DFN
  1. D FULL^VALM1
  1. S DIC=2,DIC(0)="AEMQ" D ^DIC
  1. S PXCEDATA=+Y
  1. PAT1 S %=1 I Y>0 W !," ...OK" D YN^DICN I %=0 W " Answer With 'Yes' or 'No'" G PAT1
  1. I %'=1!$D(DIRUT) S (Y,PXCEDATA)=-1
  1. I +Y'>0 D Q
  1. . I $G(DFN)'>0 S VALMSG=$C(7)_"Patient has not been selected." W !!,$G(VALMSG) H 1
  1. I +Y>0 S DFN=+Y D 2^VADPT I +VADM(6) N DIR D I $D(DIRUT) S PXCEDATA=-1
  1. . S DIR(0)="E",DIR("A")="Enter RETURN to continue or '^' to exit"
  1. . S DIR("A",1)="WARNING "_VADM(7) D ^DIR
  1. Q
  1. ;
  1. PATINFO(PXCEDATA) ;
  1. Q:$G(PXCEDATA)'>0
  1. S (DFN,SDFN,ORVP)=PXCEDATA
  1. D:$G(PXCECAT)="SIT"!($G(PXCECAT)="HIST")!($G(PXCECAT)="AEP")!$G(FSEL) DTHINFO
  1. I $D(DIRUT),$G(FSEL) D PATKILL Q
  1. ;D 2^VADPT I +VADM(6) D K DIR I $D(DIRUT) D:$G(PXCECAT)'="SIT"&($G(PXCECAT)'="HIST")&($G(PXCECAT)'="AEP") PATKILL Q
  1. ;. S DIR(0)="E",DIR("A")="Enter RETURN to continue or '^' to Quit"
  1. ;. S DIR("A",2)="WARNING "_VADM(7),DIR("A",1)=" ",DIR("A",3)=" " D ^DIR
  1. N Y
  1. S Y=PXCEDATA
  1. ;Set IHS patient variables
  1. D START^AUPNPAT
  1. D PATNAME(.PXCEDATA)
  1. N VAERR,VAROOT,PXCEVA,PXCEINDX
  1. S VAROOT="PXCEVA"
  1. D ELIG^VADPT
  1. S PXCEDATA("ELIG")=$P($G(PXCEVA(1)),"^",1,99)
  1. S PXCEINDX=""
  1. F S PXCEINDX=$O(PXCEVA(1,PXCEINDX)) Q:'PXCEINDX S PXCEDATA("ELIG",PXCEINDX)=$P(PXCEVA(1,PXCEINDX),"^",1,99)
  1. Q
  1. ;
  1. DTHINFO ;DEATH WARNING
  1. D 2^VADPT N DIR I +VADM(6) D
  1. . S DIR(0)="E",DIR("A")="Enter RETURN to continue or '^' to Quit"
  1. . S DIR("A",2)="WARNING "_VADM(7),DIR("A",1)=" ",DIR("A",3)=" " D ^DIR
  1. Q
  1. PATNAME(PXCEDATA) ;
  1. S PXCEDATA("NAME")=$P($G(^DPT(+PXCEDATA,0)),"^",1)
  1. N VAPTYP,VA,VAERR,DFN
  1. S DFN=+PXCEDATA
  1. D PID^VADPT6
  1. I 'VAERR S PXCEDATA("SSN")=VA("PID"),PXCEDATA("SSN_BRIEF")=VA("BID")
  1. E S (PXCEDATA("SSN"),PXCEDATA("SSN_BRIEF"))=""
  1. Q
  1. ;
  1. PATKILL ;
  1. K PXCEPAT,DFN,SDFN,ORVP,VADM,VAEL,VALMSG
  1. ; Kill IHS patient variables
  1. D KILL^AUPNPAT
  1. Q
  1. ;
  1. APPOINT(DFN,DATETIME,HOSLOC) ;See if there is an appointment.
  1. ;Input:
  1. ; DFN ien of the patient
  1. ; DATETIME the date and time of the appointment
  1. ; HOSLOC optional, is the Hospital Location (#44)
  1. ;Returns the clinic ien or -1 if no appointement.
  1. ;
  1. N VASD,HL,INDEX,VAERR
  1. K ^UTILITY("VASD",$J)
  1. S VASD("T")=DATETIME
  1. S VASD("F")=DATETIME-.00000001
  1. S VASD("W")=129 ;1)Active/Kept 2)Inpatient appts. only 9)No action taken
  1. S:$G(HOSLOC) VASD("C",HOSLOC)=""
  1. D SDA^VADPT
  1. I VAERR S HL=-1 G QAPPOINT
  1. S INDEX=$O(^UTILITY("VASD",$J,0))
  1. I INDEX>0 S HL=$P(^UTILITY("VASD",$J,INDEX,"I"),"^",2)
  1. E S HL=-1
  1. QAPPOINT K ^UTILITY("VASD",$J)
  1. Q HL
  1. ;