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

GMPLMGR1.m

Go to the documentation of this file.
  1. GMPLMGR1 ; SLC/MKB -- Problem List VALM Utilities cont ;5/10/94 16:42
  1. ;;2.0;Problem List;**10**;Aug 25, 1994
  1. NEWPAT ; select new patient
  1. N NEWPT S VALMBCK="R"
  1. I GMPARAM("PRT"),$D(GMPRINT) D AUTO^GMPLMGR2 I $D(DTOUT) S VALMBCK="Q" Q
  1. W ! D FULL^VALM1
  1. S NEWPT=$S($D(ORVP)&(+$$VERSION^XPDUTL("OR")<3):$$OEPAT,1:$$PAT^GMPLX1)
  1. I (+NEWPT>0),(+NEWPT'=+GMPDFN) D
  1. . S GMPDFN=NEWPT,VALMBG=1
  1. . S (GMPSC,GMPAGTOR,GMPION,GMPGULF)=0 D:GMPVA VADPT^GMPLX1(+GMPDFN)
  1. . D GETPLIST(.GMPLIST,.GMPTOTAL,.GMPLVIEW) K GMPRINT
  1. . D BUILD^GMPLMGR(.GMPLIST),HDR^GMPLMGR
  1. S VALMSG=$$MSG^GMPLX
  1. Q
  1. ;
  1. OEPAT() ; Calls OE/RR to return new patient, or -1
  1. N DFN,VADM,Y
  1. D IN^OR I +ORVP'>0 Q -1
  1. I +ORVP=+GMPDFN Q GMPDFN
  1. S DFN=+ORVP D DEM^VADPT
  1. S Y=DFN_U_VADM(1)_U_$E(VADM(1))_VA("BID")
  1. I VADM(6) S Y=Y_U_+VADM(6) ; date of death
  1. Q Y
  1. ;
  1. INACTIVE ; Incl inactive problems
  1. S VALMBCK=$S(VALMCC:"",1:"R")
  1. I GMPLVIEW("ACT")="" D Q
  1. . W !!,"Listing already includes inactive problems!" H 1
  1. I '$D(^AUPNPROB("ACTIVE",+GMPDFN,"I")) D Q
  1. . W !!,"Patient has no inactive problems to include.",! H 1
  1. S GMPLVIEW("ACT")="",VALMBCK="R",VALMSG=$$MSG^GMPLX
  1. D GETPLIST(.GMPLIST,.GMPTOTAL,.GMPLVIEW),BUILD^GMPLMGR(.GMPLIST),HDR^GMPLMGR
  1. Q
  1. ;
  1. NEWSRV ; select new service
  1. N DIC,NEWVIEW,VIEW,PROMPT,HELPMSG Q:$D(GMPQUIT)
  1. S DIC="^DIC(49,",DIC("S")="I $P(^(0),U,9)=""C"""
  1. S VIEW="service(s)",PROMPT="Select SERVICE: ",HELPMSG="LISTSERV"
  1. D NEW Q:$D(GMPQUIT)
  1. I NEWVIEW'=$E(GMPLVIEW("VIEW"),2,99) S GMPLVIEW("VIEW")="S"_NEWVIEW,GMPREBLD=1
  1. Q
  1. ;
  1. NEWCLIN ; Select new clinic
  1. N DIC,NEWVIEW,VIEW,PROMPT,HELPMSG Q:$D(GMPQUIT)
  1. S DIC="^SC(",DIC("S")="I $P(^(0),U,3)=""C"""
  1. S VIEW="clinic(s)",PROMPT="Select CLINIC: ",HELPMSG="LISTCLIN"
  1. D NEW Q:$D(GMPQUIT)
  1. I NEWVIEW'=$E(GMPLVIEW("VIEW"),2,99) S GMPLVIEW("VIEW")="C"_NEWVIEW,GMPREBLD=1
  1. Q
  1. ;
  1. NEW ; prompt, from NEWSRV or NEWCLIN
  1. N X,Y S NEWVIEW="",DIC(0)="EMQ"
  1. W !!,"Enter the "_VIEW_" from which you wish to view problems:"
  1. F D Q:$D(GMPQUIT)!(X="")
  1. . W !,PROMPT R X:DTIME I '$T!(X["^") S GMPQUIT=1 Q
  1. . Q:X="" I X="?" W !!?3,"Enter the "_VIEW_", one at a time, from which you wish to view",!?3,"problems; press <return> when you have finished.",! Q
  1. . I X["??" D @HELPMSG Q
  1. . D ^DIC I Y>0 S NEWVIEW=NEWVIEW_+Y_"/",PROMPT="ANOTHER ONE: "
  1. I '$D(GMPQUIT),$L(NEWVIEW) S NEWVIEW="/"_NEWVIEW
  1. Q
  1. ;
  1. LISTSERV ; List clinical services
  1. N I,CNT,Y S CNT=0,Y=""
  1. W !,"Choose from: "
  1. F I=0:0 S I=$O(^DIC(49,"F","C",I)) Q:I'>0 D Q:Y'=""
  1. . S CNT=CNT+1 I '(CNT#8) D Q:Y="^"
  1. . . W " ... more, or ^ to stop: " R Y:DTIME S:'$T Y="^"
  1. . W !," "_$P(^DIC(49,I,0),U)
  1. . W:$P(^(0),U,4) " ("_$P(^DIC(49,$P(^(0),U,4),0),U)_")"
  1. W ! Q
  1. ;
  1. LISTCLIN ; List clinics
  1. N I,CNT,Y S CNT=0,Y=""
  1. W !,"Choose from: "
  1. F I=0:0 S I=$O(^SC(I)) Q:I'>0 D Q:Y'=""
  1. . Q:$P($G(^SC(I,0)),U,3)'="C" ; must be a clinic
  1. . S CNT=CNT+1 I '(CNT#8) D Q:Y="^"
  1. . . W " ... more, or ^ to stop: " R Y:DTIME S:'$T Y="^"
  1. . W !," "_$P($G(^SC(I,0)),U)
  1. W ! Q
  1. ;
  1. NEWPROV ; select new provider
  1. N X,Y,DIC,NEWPROV Q:$D(GMPQUIT) S NEWPROV=""
  1. S DIC="^VA(200,",DIC(0)="EMQ" ; screen on PROVIDER key ??
  1. W !!,"Enter the name of the provider whose problems you wish to view:"
  1. NPRV R !,"Select PROVIDER: ",X:DTIME I '$T!(X["^") S GMPQUIT=1 Q
  1. Q:X="" I X="?" D G NPRV
  1. . W !!?3,"If you wish to see only those problems of the current patient that"
  1. . W !?3,"are associated with a specific provider, enter his/her name here.",!
  1. I X["??" D NPHELP^GMPLEDT2 G NPRV
  1. D ^DIC S:+Y NEWPROV=Y I +Y'>0 G NPRV
  1. I +NEWPROV'=+GMPLVIEW("PROV") S GMPLVIEW("PROV")=NEWPROV,GMPREBLD=1
  1. Q
  1. ;
  1. KEYS ; adds to XQORM("KEY") array
  1. I $G(GMPARAM("VER")) S XQORM("KEY","$")=$O(^ORD(101,"B","GMPL VERIFY",0))_"^1"
  1. KEY S XQORM("KEY","=")=$O(^ORD(101,"B","VALM NEXT SCREEN",0))_"^1"
  1. Q
  1. ;
  1. GETPLIST(PLIST,TOTAL,VIEW) ; Build PLIST(#)=IFN for view
  1. N STBEG,STEND,ST,CNT,IFN,RECORD,DATE,LIST K PLIST
  1. W:'$G(GMPARAM("QUIET")) !,"Searching for the patient's problem list ..."
  1. S STBEG=$S(VIEW("ACT")="I":"A",1:""),STEND=$S(VIEW("ACT")="A":"I",1:""),ST=STBEG,TOTAL=0
  1. F S ST=$O(^AUPNPROB("ACTIVE",+GMPDFN,ST)) Q:(ST="")!(ST=STEND) D
  1. . F IFN=0:0 S IFN=$O(^AUPNPROB("ACTIVE",+GMPDFN,ST,IFN)) Q:IFN'>0 D
  1. . . S RECORD=$G(^AUPNPROB(IFN,1)) Q:'$L(RECORD)
  1. . . Q:$P(RECORD,U,2)="H" S TOTAL=TOTAL+1
  1. . . I $L(VIEW("VIEW"))>2,VIEW("VIEW")'[("/"_$P(RECORD,U,$S($E(VIEW("VIEW"))="S":6,1:8))_"/") Q
  1. . . I VIEW("PROV"),$P(RECORD,U,5)'=+VIEW("PROV") Q
  1. . . S DATE=$P(RECORD,U,9) S:'DATE DATE=$P($G(^AUPNPROB(IFN,0)),U,8)
  1. . . S:GMPARAM("REV") DATE=9999999-DATE
  1. . . S LIST(ST,DATE,IFN)=""
  1. S ST="",CNT=0 F S ST=$O(LIST(ST)) Q:ST="" D
  1. . S DATE="" F S DATE=$O(LIST(ST,DATE)) Q:DATE="" D
  1. . . S IFN="" F S IFN=$O(LIST(ST,DATE,IFN)) Q:IFN="" S CNT=CNT+1,PLIST(CNT)=IFN,PLIST("B",IFN)=CNT
  1. S PLIST(0)=CNT
  1. Q