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

PXCE.m

Go to the documentation of this file.
  1. PXCE ;ISL/dee - Main routine for PCE's user interface ; 3/27/01 12:17pm
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**25,47,52,64,75,78,147,151,161**;Aug 12, 1996
  1. ;
  1. ;PXCEKEYS is a set of letters that enable the user
  1. ; to enter certain fields
  1. ; "P" is included if the user holds the AK.PROVIDER key.
  1. ; "C" should be included by the option if the user should be
  1. ; asked for the Provider Narrative Categories on V CPT, V POV,
  1. ; and V TREATMENT files. As well as for other fields that are
  1. ; not ask of the normal user.
  1. ; "S" is for the superviser. If they have "S" then they will be
  1. ; given "C" and "D" by the program.
  1. ; "V" is for view only
  1. ; And if it:
  1. ; includes "D" to delete any V-File
  1. ; includes "d" to only delete V-File entries this user created
  1. ;
  1. I '$D(PXCEKEYS)#2 N PXCEKEYS S PXCEKEYS=""
  1. S:PXCEKEYS'["D" PXCEKEYS=PXCEKEYS_"D"
  1. G START
  1. ; -- main entry point for PCE's user interface
  1. EN1(PXCEKEYS) ;Does not checks for provider
  1. G START1
  1. EN(PXCEKEYS) ;Checks for provider
  1. ;
  1. START ;
  1. ;Key for provider (P)
  1. I PXCEKEYS'["P",$O(^VA(200,"AK.PROVIDER",$P(^VA(200,DUZ,0),"^"),""))=DUZ S PXCEKEYS=PXCEKEYS_"P"
  1. START1 ;
  1. ;If they have the Key for superviser (S) make sure that they also
  1. ; have C and D.
  1. I PXCEKEYS["S" S:PXCEKEYS'["C" PXCEKEYS=PXCEKEYS_"C" S:PXCEKEYS'["D" PXCEKEYS=PXCEKEYS_"D"
  1. ;
  1. K I,X,SDB,XQORNOD,SDFN,SDCLN,DA,DR,DIE,DNM,DQ,%B
  1. N PXCEVIEW,SDAMTYP
  1. N PXCEPAT,PXCEHLOC
  1. N PXCEDBEG,PXCEDEND,PXCE9BEG,PXCE9END,SDBEG,SDEND
  1. N PXCEDBP,PXCEDBHL,PXCEDEP,PXCEDEHL
  1. N PXCECONT
  1. N PXCESOR,PXCEPKG
  1. I $G(DFN)'>0 N DFN
  1. ;
  1. S PXCEVIEW="^"_$S("~V~A~"["~"_$P(^PX(815,1,"LM"),"^",2)_"~":$P(^PX(815,1,"LM"),"^",2),1:"V")_"^"
  1. S PXCESOR=$$SOURCE^PXAPIUTL("PXCE DATA ENTRY")
  1. S PXCEPKG=$$PKG2IEN^VSIT("PX")
  1. ;
  1. K DIRUT
  1. D SETUP Q:$D(DIRUT)
  1. ;
  1. F D Q:$D(PXCEVIEW)'=1!'$D(PXCECONT)
  1. . K PXCECONT
  1. . I PXCEKEYS["V" D
  1. .. I PXCEVIEW["A" D
  1. ... D EN^VALM("PXCE SDAM VIEW ONLY")
  1. .. E D EN^VALM("PXCE VIEW ONLY")
  1. . E I PXCEVIEW["A" D
  1. .. D EN^VALM("PXCE SDAM MENU")
  1. . E D EN^VALM("PXCE MAIN MENU")
  1. D FULL^VALM1
  1. D EXITALL
  1. Q
  1. ;
  1. SETUP ;
  1. N DIR,DA,X,Y,PXRES
  1. N PXCEUSEL,X1,X2
  1. I $G(DFN)>0 S PXCEUSEL=DFN_"^DPT("
  1. E S DIR(0)="815,201",DIR("A")="Select Patient or Clinic name" D ^DIR K DIR,DA Q:$D(DIRUT) S PXCEUSEL=Y
  1. S X1=DT,X2=$S($P(^PX(815,1,"LM"),"^",3)]"":$P(^PX(815,1,"LM"),"^",3),1:-30) D C^%DTC
  1. S PXCEDBP=X
  1. S X1=DT,X2=$S($P(^PX(815,1,"LM"),"^",4)]"":$P(^PX(815,1,"LM"),"^",4),1:0) D C^%DTC
  1. S PXCEDEP=X
  1. S X1=DT,X2=$S($P(^PX(815,1,"LM"),"^",5)]"":$P(^PX(815,1,"LM"),"^",5),1:-7) D C^%DTC
  1. S PXCEDBHL=X
  1. S X1=DT,X2=$S($P(^PX(815,1,"LM"),"^",6)]"":$P(^PX(815,1,"LM"),"^",6),1:0) D C^%DTC
  1. S PXCEDEHL=X
  1. I PXCEUSEL["DPT(" S $P(PXCEVIEW,"^",1)="P" S SDAMTYP="P"
  1. I PXCEUSEL["SC(" S $P(PXCEVIEW,"^",1)="H" S SDAMTYP="C" D I 'PXRES G SETUP
  1. .S PXRES=$$CLNCK^SDUTL2(+PXCEUSEL,1)
  1. .I 'PXRES W !,?5,"Clinic MUST be corrected before continuing."
  1. D SETDATES
  1. I PXCEUSEL["DPT(" S PXCEPAT=+PXCEUSEL,FSEL=1 D NEWPAT1^PXCEPAT K FSEL G:$D(DIRUT) SETUP
  1. I PXCEUSEL["SC(" S PXCEHLOC=+PXCEUSEL D NEWHOSL1^PXCENEW
  1. Q
  1. ;
  1. SETDATES ;
  1. I PXCEVIEW["H" D
  1. . S PXCEDBEG=PXCEDBHL
  1. . S PXCEDEND=PXCEDEHL
  1. E D
  1. . S PXCEDBEG=PXCEDBP
  1. . S PXCEDEND=PXCEDEP
  1. D DATE9S^PXCEDATE
  1. Q
  1. ;
  1. HDR ; -- header code
  1. K VALMHDR,PXLNX,PXPCP
  1. S PXLNX=1,PXPCP=""
  1. ;
  1. ;PATIENT
  1. I PXCEVIEW["P" D
  1. . S PXPCP=$$PCLINE^SDPPTEM(PXCEPAT,DT)
  1. . S VALMHDR(PXLNX)=$E(PXCEPAT("NAME"),1,26)
  1. . S VALMHDR(PXLNX)=$E(VALMHDR(PXLNX)_$E(" ",1,(27-$L(VALMHDR(PXLNX))))_PXCEPAT("SSN")_" ",1,40)
  1. E S VALMHDR(PXLNX)=" "
  1. ;LOCATION
  1. S VALMHDR(PXLNX)=VALMHDR(PXLNX)_"Clinic: "_$S($G(PXCEHLOC)&(PXCEVIEW'["P^A"):$P(^SC(PXCEHLOC,0),"^"),1:"All")
  1. S PXLNX=PXLNX+1
  1. I $L(PXPCP) S VALMHDR(PXLNX)=PXPCP,PXLNX=PXLNX+1
  1. ;
  1. ;DATE
  1. S VALMHDR(PXLNX)=$E("Date range: "_$$FMTE^XLFDT(PXCEDBEG,5)_" to "_$$FMTE^XLFDT(PXCEDEND,5)_$J("",40),1,40)
  1. ;
  1. ;Credit Stop
  1. S:PXCEVIEW["A" VALMHDR(PXLNX)=VALMHDR(PXLNX)_$P($G(SDAMLIST),"^",2)
  1. S PXLNX=PXLNX+1
  1. ;
  1. ;CHECK IF GAF NEEDED
  1. I PXCEVIEW'["P",$$MHCLIN^SDUTL2(PXCEHLOC) S VALMHDR(PXLNX)=$$SETSTR^VALM1("* - New GAF Score Required","",25,80)
  1. I PXCEVIEW["P" D
  1. .S VALMHDR(PXLNX)=$$SETSTR^VALM1("* - New GAF Score Required","",25,80)
  1. .N PXCEHLC,PXCESTA
  1. .K PXCEHIT
  1. .S PXCESTA=$$ELSTAT^SDUTL2(PXCEPAT)
  1. .S PXCEZZ=0
  1. .F S PXCEZZ=$O(^TMP("PXCEIDX",$J,PXCEZZ)) Q:PXCEZZ'>0 D Q:$D(PXCEHIT)
  1. ..S PXCEHLC=+$P($G(^AUPNVSIT(^TMP("PXCEIDX",$J,PXCEZZ),0)),"^",22)
  1. ..I $$MHCLIN^SDUTL2(PXCEHLC),'$$COLLAT^SDUTL2(PXCESTA) D
  1. ...S PXCEGAF=$$NEWGAF^SDUTL2($S($D(SDFN):SDFN,$D(PXCEPAT):PXCEPAT,1:""))
  1. ...S PXCEGST=$P(PXCEGAF,"^")
  1. ...I PXCEGST D
  1. ....S PXCEGDT=$$FMTE^XLFDT($P(PXCEGAF,"^",3),"5M"),PXCEGSC=$P(PXCEGAF,"^",2),PXCEGPR=$P(PXCEGAF,"^",4)
  1. ....S VALMHDR(PXLNX)="GAF Date: "_PXCEGDT_" GAF Score:"_PXCEGSC_" NEW REQ",PXCEHIT=1
  1. ;
  1. S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. D MAKELIST^PXCENEW
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. D FULL^VALM1
  1. D CLEAN^VALM10
  1. K ^TMP("PXCE",$J)
  1. K ^TMP("PXCEIDX",$J)
  1. D FNL^PXCESDAM
  1. Q
  1. ;
  1. EXITALL ; Exit of whole program
  1. D PATKILL^PXCEPAT
  1. D KVA^VADPT
  1. Q
  1. ;
  1. DONE ; -- exit action for protocol
  1. S:'$D(VALMBCK) VALMBCK="R"
  1. S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. D EN^PXCEEXP
  1. Q
  1. ;
  1. SEL1(HELP,PXCEADD) ; Select 1 visit
  1. ; If the $GET(PXCEADD) is non zero then will
  1. ; add to the prompt "add a new encounter"
  1. N X,Y,MAX
  1. S MAX=+$G(^TMP("PXCEIDX",$J,0)) I MAX'>0 Q "^"
  1. S Y=$P($P(XQORNOD(0),"^",4),"=",2)
  1. I Y]"" D
  1. . I (+Y'=Y)!(+Y>MAX)!(+Y<1)!(Y#1'=0) D
  1. .. W !,$C(7),"Selection '",Y,"' is not a valid choice."
  1. .. D PAUSE^PXCEHELP
  1. .. S Y="^"
  1. E I '$G(PXCEADD) D
  1. . N DIR,DA
  1. . S DIR(0)="NAO^1:"_MAX_":0",DIR("A")="Select Encounter"
  1. . S:MAX>1 DIR("A")=DIR("A")_" (1-"_MAX_"): "
  1. . S:MAX'>1 DIR("A")=DIR("A")_": ",DIR("B")=1
  1. . S DIR("?")="Enter the number of the Encounter you wish to "
  1. . S DIR("?")=DIR("?")_$S($L(HELP):HELP,1:"act on")
  1. . D ^DIR I $D(DTOUT)!(X="") S Y="^"
  1. E D
  1. . N DIR,DA
  1. ASKLOOP . S DIR(0)="FAO^1:"_$L(MAX)
  1. . S DIR("A")="Enter 1-"_MAX_" to Edit, or 'A' to Add: "
  1. . S DIR("?")="Enter the number of the Encounter you wish "
  1. . S DIR("?")=DIR("?")_$S($L(HELP):HELP,1:"act on")_" or A to "
  1. . S DIR("?")=DIR("?")_$S($L(HELP):HELP,1:"act on")_" add a new Encounter"
  1. . D ^DIR
  1. . K DIR,DA
  1. . I $D(DIRUT)!(X="") S Y="^" Q
  1. . I "Aa"[Y S Y="A" Q
  1. . G:Y<1!(Y>MAX) ASKLOOP
  1. Q Y
  1. ;
  1. GAF ;;
  1. N PXCEVIEN,PXDFN,PXDSS,PXELIG,PXDATA
  1. I $G(PXCEHLOC),'$$MHCLIN^SDUTL2(PXCEHLOC) D G SKIP
  1. . S DIR(0)="FOA"
  1. . S DIR("A",1)=" This is not a Mental Health Clinic, a GAF Score may not be entered."
  1. . S DIR("A")=" Press any key to continue: "
  1. . D ^DIR K DIR
  1. ;
  1. I $D(^TMP("PXCEIDX",$J)) D GETVIEN^PXCEAE
  1. I $D(^TMP("SDAMIDX",$J)) S PXCEVIEN=$$SELAPPM^PXCESDAM
  1. I '($G(PXCEVIEN)]"")!($G(PXCEVIEN)=-1) D S VALMBCK="R" Q
  1. . S DIR(0)="FAO"
  1. . I '($G(PXCEVIEN)]"") S DIR("A",1)="Nothing to select."
  1. . I $G(PXCEVIEN)=-1 S DIR("A",1)="No selections made."
  1. . S DIR("A")="Press any key to continue."
  1. . D ^DIR K DIR
  1. S PXDFN=$P($G(^AUPNVSIT(PXCEVIEN,0)),"^",5)
  1. S PXDSS=$P($G(^AUPNVSIT(PXCEVIEN,0)),"^",8)
  1. S PXDATA=$G(^DPT(PXDFN,"S",$P(^AUPNVSIT(PXCEVIEN,0),U),0))
  1. S PXELIG=$$ELSTAT^SDUTL2(PXDFN)
  1. I $$MHCLIN^SDUTL2("",PXDSS),'($$COLLAT^SDUTL2(PXELIG)!$P(PXDATA,U,11)) D
  1. . S PXGAF=$$NEWGAF^SDUTL2(PXDFN)
  1. . D FULL^VALM1
  1. . W !
  1. . I +$P(PXGAF,U,5)>0 W !,"Warning: Patient is deceased."
  1. . W !,"Current GAF: "_+$P(PXGAF,U,2)
  1. . W $S($P(PXGAF,U,3)>0:", from "_$$FMTE^XLFDT($P(PXGAF,U,3),"D"),1:", Date Unavailable")
  1. . D EN^SDGAF(PXDFN)
  1. E D
  1. . S DIR(0)="FOA"
  1. . S DIR("A",1)="A GAF Score is not required for this appointment!"
  1. . S DIR("A")="Press any key to continue: "
  1. . D ^DIR K DIR
  1. ;
  1. SKIP S VALMBCK="R"
  1. GAFQ Q
  1. ;