- 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 Jan 18, 2025@03:31:19 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