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