ORCPROB ; SLC/MKB/REV - Problem List interface ;03/27/14 09:57
;;3.0;ORDER ENTRY/RESULTS REPORTING;**27,48,181,385**;Dec 17, 1997;Build 12
ADD ; -- add new problem
N GMPLIST,ORPROV
D FULL^VALM1 S VALMBCK="R",ORPROV=$$PROVIDER Q:ORPROV="^"
S:'$G(ORL) ORL=$$LOCATION^ORCMENU1 Q:'ORL
D ADD^GMPLUTL2(+ORVP,+ORL,ORPROV)
D:$O(GMPLIST(0)) TAB^ORCHART(ORTAB,1)
Q
;
EDIT ; -- edit problem
N GMPLIST,ORPROV,PIECE,NMBR,IFN S VALMBCK=""
I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("edit") Q:'ORNMBR
D FULL^VALM1 S VALMBCK="R",ORPROV=$$PROVIDER Q:ORPROV="^"
S:'$G(ORL) ORL=$$LOCATION^ORCMENU1 Q:'ORL
F PIECE=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",PIECE) I NMBR D
. S IFN=+$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
. I 'IFN W !,"Problem #"_NMBR_" has been removed!",! H 1 Q
. K GMPLIST D EDIT^GMPLUTL2(+ORVP,+ORL,ORPROV,IFN)
. S:$D(GMPLIST) OREBUILD=1
Q
;
INACT ; -- inactivate a problem
N ORPROV,ORPL,ORY,NUM,NMBR,PIECE,IFN,STS S VALMBCK=""
I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("inactivate") Q:'ORNMBR
S NUM=$L(ORNMBR,",")-1 Q:'$$OK("inactivate",NUM)
S ORPROV=$$PROVIDER Q:ORPROV="^"
F PIECE=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",PIECE) I NMBR D
. S IFN=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR)),STS=$P(IFN,U,4),IFN=+IFN
. I 'IFN W !,"Problem #"_NMBR_" has been removed!",! H 1 Q
. I STS="I" W !,"Problem #"_NMBR_" is already inactive!",! H 1 Q
. S ORPL("PROVIDER")=ORPROV,ORPL("STATUS")="I",ORPL("PROBLEM")=IFN
. W !,$$PROBTEXT^GMPLX(IFN)
. D UPDATE^GMPLUTL(.ORPL,.ORY) I ORY'>0 W !?5,"ERROR - "_ORY(0) H 1 Q
. W:$X>64 !?5 W " ... inactivated" H 1 S OREBUILD=1
. S $P(^TMP("OR",$J,"CURRENT","IDX",NMBR),U,4)="I"
Q
;
CMMT ; -- comment problem
N DIR,X,Y,ORPL,ORY,NMBR,PIECE,QUIT,TEXT,ORPROV,CMMT S VALMBCK=""
I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") Q:'ORNMBR
D FULL^VALM1 S VALMBCK="R",ORPROV=$$PROVIDER Q:ORPROV="^"
S CMMT=+$P($P($G(^TMP("OR",$J,ORTAB,0)),U,3),";",4) ;show comments
F PIECE=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",PIECE) I NMBR D Q:$D(QUIT)
. S IFN=+$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
. I 'IFN W !,"Problem #"_NMBR_" has been removed!",! H 2 Q
. S DIR(0)="FAO^1:60",DIR("A")="COMMENT (<60 char): "
. S DIR("A",1)=$$UP^XLFSTR($$PROBTEXT^GMPLX(IFN))
. S DIR("?")="Enter up to 60 characters of additional text to be appended to this problem" S:$D(TEXT) DIR("B")=TEXT
. W ! D ^DIR I $D(DTOUT)!("^"[Y) S QUIT=1 Q
. S (TEXT,ORPL("COMMENT"))=Y,ORPL("PROBLEM")=IFN
. S ORPL("PROVIDER")=ORPROV
. D UPDATE^GMPLUTL(.ORPL,.ORY) S:CMMT&(ORY>0) OREBUILD=1
. W !?5,$S(ORY>0:"... 1 comment added",1:"ERROR - "_ORY(0)) H 1
Q
;
REMOVE ; -- remove problem
N DIR,X,Y,IFN,TEXT,ORY,SUB,NUM,NMBR,PIECE,QUIT,ORPROV S VALMBCK=""
I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("remove") Q:'ORNMBR
S NUM=$L(ORNMBR,",")-1 Q:'$$OK("remove",NUM)
D FULL^VALM1 S VALMBCK="R",ORPROV=$$PROVIDER Q:ORPROV="^"
F PIECE=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",PIECE) I NMBR D Q:$D(QUIT)
. S IFN=+$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
. I 'IFN W !,"Problem #"_NMBR_" has already been removed!",! H 1 Q
. S DIR(0)="FAO^1:60",DIR("A")="REASON FOR REMOVAL: "
. S DIR("A",1)=$$UP^XLFSTR($$PROBTEXT^GMPLX(IFN))
. S:$D(TEXT) DIR("B")=TEXT
. S DIR("?")="Enter up to 60 characters of additional text to be appended to this problem"
. W ! D ^DIR I $D(DTOUT)!($D(DUOUT)) S QUIT=1 Q
. S TEXT=Y D REMOVE^GMPLUTL2(IFN,ORPROV,TEXT,.ORY)
. I ORY'>0 W !?5,"ERROR - "_ORY(0) H 1 Q
. W !?5,"... removed" H 1 S OREBUILD=1
Q
;
VERIFY ; -- verify problem
I '$P($$PARAM^GMPLUTL2,U,2) W !,"This action is not in use.",! H 1 Q
I '$D(^XUSEC("ORES",DUZ)),'$D(^XUSEC("ORELSE",DUZ)) W !,"You must have either the ORES or ORELSE key to verify these problems!",! H 1 Q
N NUM,PIECE,GMPIFN,OROLD S VALMBCK=""
I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("verify") Q:'ORNMBR
S VALMBCK="",NUM=$L(ORNMBR,",")-1 Q:'$$OK("verify",NUM)
F PIECE=1:1:$L(ORNMBR,",") S NUM=$P(ORNMBR,",",PIECE) I NUM D
. S GMPIFN=+$G(^TMP("OR",$J,"CURRENT","IDX",NUM))
. I 'GMPIFN W !,"Problem #"_NUM_" has already been removed!",! H 1 Q
. S OROLD=$G(^AUPNPROB(GMPIFN,1)) D VERIFY^GMPL1
. S:OROLD'=$G(^AUPNPROB(GMPIFN,1)) OREBUILD=1
Q
;
OK(ACTION,NUM) ; -- Are you sure?
N DIR,X,Y
S DIR(0)="YA",DIR("B")="NO",DIR("A")="Are you sure you want to "_ACTION_" "_$S(NUM>1:"these problems? ",1:"this problem? ")
S DIR("?")="Enter YES to continue with this action, or NO to cancel"
D ^DIR
Q +Y
;
PROVIDER() ; --Return Responsible Provider
N X,Y,DIC
I '$D(^XUSEC("OREMAS",DUZ)),'$G(ORNP)!($G(ORNP)=DUZ) S Y=DUZ_U_$P($G(^VA(200,DUZ,0)),U) G PVQ
S DIC=200,DIC(0)="AEQM",DIC("A")="Requesting Clinician: "
S:$G(ORNP) DIC("B")=ORNP D ^DIC S:Y'>0 Y="^"
PVQ Q Y
;
EX ; -- exit action
D:$G(OREBUILD) TAB^ORCHART(ORTAB,1)
S:$D(^TMP("OR",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCPROB 4870 printed Dec 13, 2024@02:28:56 Page 2
ORCPROB ; SLC/MKB/REV - Problem List interface ;03/27/14 09:57
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**27,48,181,385**;Dec 17, 1997;Build 12
ADD ; -- add new problem
+1 NEW GMPLIST,ORPROV
+2 DO FULL^VALM1
SET VALMBCK="R"
SET ORPROV=$$PROVIDER
if ORPROV="^"
QUIT
+3 if '$GET(ORL)
SET ORL=$$LOCATION^ORCMENU1
if 'ORL
QUIT
+4 DO ADD^GMPLUTL2(+ORVP,+ORL,ORPROV)
+5 if $ORDER(GMPLIST(0))
DO TAB^ORCHART(ORTAB,1)
+6 QUIT
+7 ;
EDIT ; -- edit problem
+1 NEW GMPLIST,ORPROV,PIECE,NMBR,IFN
SET VALMBCK=""
+2 IF '$GET(ORNMBR)
SET ORNMBR=$$ORDERS^ORCHART("edit")
if 'ORNMBR
QUIT
+3 DO FULL^VALM1
SET VALMBCK="R"
SET ORPROV=$$PROVIDER
if ORPROV="^"
QUIT
+4 if '$GET(ORL)
SET ORL=$$LOCATION^ORCMENU1
if 'ORL
QUIT
+5 FOR PIECE=1:1:$LENGTH(ORNMBR,",")
SET NMBR=$PIECE(ORNMBR,",",PIECE)
IF NMBR
Begin DoDot:1
+6 SET IFN=+$GET(^TMP("OR",$JOB,"CURRENT","IDX",NMBR))
+7 IF 'IFN
WRITE !,"Problem #"_NMBR_" has been removed!",!
HANG 1
QUIT
+8 KILL GMPLIST
DO EDIT^GMPLUTL2(+ORVP,+ORL,ORPROV,IFN)
+9 if $DATA(GMPLIST)
SET OREBUILD=1
End DoDot:1
+10 QUIT
+11 ;
INACT ; -- inactivate a problem
+1 NEW ORPROV,ORPL,ORY,NUM,NMBR,PIECE,IFN,STS
SET VALMBCK=""
+2 IF '$GET(ORNMBR)
SET ORNMBR=$$ORDERS^ORCHART("inactivate")
if 'ORNMBR
QUIT
+3 SET NUM=$LENGTH(ORNMBR,",")-1
if '$$OK("inactivate",NUM)
QUIT
+4 SET ORPROV=$$PROVIDER
if ORPROV="^"
QUIT
+5 FOR PIECE=1:1:$LENGTH(ORNMBR,",")
SET NMBR=$PIECE(ORNMBR,",",PIECE)
IF NMBR
Begin DoDot:1
+6 SET IFN=$GET(^TMP("OR",$JOB,"CURRENT","IDX",NMBR))
SET STS=$PIECE(IFN,U,4)
SET IFN=+IFN
+7 IF 'IFN
WRITE !,"Problem #"_NMBR_" has been removed!",!
HANG 1
QUIT
+8 IF STS="I"
WRITE !,"Problem #"_NMBR_" is already inactive!",!
HANG 1
QUIT
+9 SET ORPL("PROVIDER")=ORPROV
SET ORPL("STATUS")="I"
SET ORPL("PROBLEM")=IFN
+10 WRITE !,$$PROBTEXT^GMPLX(IFN)
+11 DO UPDATE^GMPLUTL(.ORPL,.ORY)
IF ORY'>0
WRITE !?5,"ERROR - "_ORY(0)
HANG 1
QUIT
+12 if $X>64
WRITE !?5
WRITE " ... inactivated"
HANG 1
SET OREBUILD=1
+13 SET $PIECE(^TMP("OR",$JOB,"CURRENT","IDX",NMBR),U,4)="I"
End DoDot:1
+14 QUIT
+15 ;
CMMT ; -- comment problem
+1 NEW DIR,X,Y,ORPL,ORY,NMBR,PIECE,QUIT,TEXT,ORPROV,CMMT
SET VALMBCK=""
+2 IF '$GET(ORNMBR)
SET ORNMBR=$$ORDERS^ORCHART("")
if 'ORNMBR
QUIT
+3 DO FULL^VALM1
SET VALMBCK="R"
SET ORPROV=$$PROVIDER
if ORPROV="^"
QUIT
+4 ;show comments
SET CMMT=+$PIECE($PIECE($GET(^TMP("OR",$JOB,ORTAB,0)),U,3),";",4)
+5 FOR PIECE=1:1:$LENGTH(ORNMBR,",")
SET NMBR=$PIECE(ORNMBR,",",PIECE)
IF NMBR
Begin DoDot:1
+6 SET IFN=+$GET(^TMP("OR",$JOB,"CURRENT","IDX",NMBR))
+7 IF 'IFN
WRITE !,"Problem #"_NMBR_" has been removed!",!
HANG 2
QUIT
+8 SET DIR(0)="FAO^1:60"
SET DIR("A")="COMMENT (<60 char): "
+9 SET DIR("A",1)=$$UP^XLFSTR($$PROBTEXT^GMPLX(IFN))
+10 SET DIR("?")="Enter up to 60 characters of additional text to be appended to this problem"
if $DATA(TEXT)
SET DIR("B")=TEXT
+11 WRITE !
DO ^DIR
IF $DATA(DTOUT)!("^"[Y)
SET QUIT=1
QUIT
+12 SET (TEXT,ORPL("COMMENT"))=Y
SET ORPL("PROBLEM")=IFN
+13 SET ORPL("PROVIDER")=ORPROV
+14 DO UPDATE^GMPLUTL(.ORPL,.ORY)
if CMMT&(ORY>0)
SET OREBUILD=1
+15 WRITE !?5,$SELECT(ORY>0:"... 1 comment added",1:"ERROR - "_ORY(0))
HANG 1
End DoDot:1
if $DATA(QUIT)
QUIT
+16 QUIT
+17 ;
REMOVE ; -- remove problem
+1 NEW DIR,X,Y,IFN,TEXT,ORY,SUB,NUM,NMBR,PIECE,QUIT,ORPROV
SET VALMBCK=""
+2 IF '$GET(ORNMBR)
SET ORNMBR=$$ORDERS^ORCHART("remove")
if 'ORNMBR
QUIT
+3 SET NUM=$LENGTH(ORNMBR,",")-1
if '$$OK("remove",NUM)
QUIT
+4 DO FULL^VALM1
SET VALMBCK="R"
SET ORPROV=$$PROVIDER
if ORPROV="^"
QUIT
+5 FOR PIECE=1:1:$LENGTH(ORNMBR,",")
SET NMBR=$PIECE(ORNMBR,",",PIECE)
IF NMBR
Begin DoDot:1
+6 SET IFN=+$GET(^TMP("OR",$JOB,"CURRENT","IDX",NMBR))
+7 IF 'IFN
WRITE !,"Problem #"_NMBR_" has already been removed!",!
HANG 1
QUIT
+8 SET DIR(0)="FAO^1:60"
SET DIR("A")="REASON FOR REMOVAL: "
+9 SET DIR("A",1)=$$UP^XLFSTR($$PROBTEXT^GMPLX(IFN))
+10 if $DATA(TEXT)
SET DIR("B")=TEXT
+11 SET DIR("?")="Enter up to 60 characters of additional text to be appended to this problem"
+12 WRITE !
DO ^DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET QUIT=1
QUIT
+13 SET TEXT=Y
DO REMOVE^GMPLUTL2(IFN,ORPROV,TEXT,.ORY)
+14 IF ORY'>0
WRITE !?5,"ERROR - "_ORY(0)
HANG 1
QUIT
+15 WRITE !?5,"... removed"
HANG 1
SET OREBUILD=1
End DoDot:1
if $DATA(QUIT)
QUIT
+16 QUIT
+17 ;
VERIFY ; -- verify problem
+1 IF '$PIECE($$PARAM^GMPLUTL2,U,2)
WRITE !,"This action is not in use.",!
HANG 1
QUIT
+2 IF '$DATA(^XUSEC("ORES",DUZ))
IF '$DATA(^XUSEC("ORELSE",DUZ))
WRITE !,"You must have either the ORES or ORELSE key to verify these problems!",!
HANG 1
QUIT
+3 NEW NUM,PIECE,GMPIFN,OROLD
SET VALMBCK=""
+4 IF '$GET(ORNMBR)
SET ORNMBR=$$ORDERS^ORCHART("verify")
if 'ORNMBR
QUIT
+5 SET VALMBCK=""
SET NUM=$LENGTH(ORNMBR,",")-1
if '$$OK("verify",NUM)
QUIT
+6 FOR PIECE=1:1:$LENGTH(ORNMBR,",")
SET NUM=$PIECE(ORNMBR,",",PIECE)
IF NUM
Begin DoDot:1
+7 SET GMPIFN=+$GET(^TMP("OR",$JOB,"CURRENT","IDX",NUM))
+8 IF 'GMPIFN
WRITE !,"Problem #"_NUM_" has already been removed!",!
HANG 1
QUIT
+9 SET OROLD=$GET(^AUPNPROB(GMPIFN,1))
DO VERIFY^GMPL1
+10 if OROLD'=$GET(^AUPNPROB(GMPIFN,1))
SET OREBUILD=1
End DoDot:1
+11 QUIT
+12 ;
OK(ACTION,NUM) ; -- Are you sure?
+1 NEW DIR,X,Y
+2 SET DIR(0)="YA"
SET DIR("B")="NO"
SET DIR("A")="Are you sure you want to "_ACTION_" "_$SELECT(NUM>1:"these problems? ",1:"this problem? ")
+3 SET DIR("?")="Enter YES to continue with this action, or NO to cancel"
+4 DO ^DIR
+5 QUIT +Y
+6 ;
PROVIDER() ; --Return Responsible Provider
+1 NEW X,Y,DIC
+2 IF '$DATA(^XUSEC("OREMAS",DUZ))
IF '$GET(ORNP)!($GET(ORNP)=DUZ)
SET Y=DUZ_U_$PIECE($GET(^VA(200,DUZ,0)),U)
GOTO PVQ
+3 SET DIC=200
SET DIC(0)="AEQM"
SET DIC("A")="Requesting Clinician: "
+4 if $GET(ORNP)
SET DIC("B")=ORNP
DO ^DIC
if Y'>0
SET Y="^"
PVQ QUIT Y
+1 ;
EX ; -- exit action
+1 if $GET(OREBUILD)
DO TAB^ORCHART(ORTAB,1)
+2 if $DATA(^TMP("OR",$JOB,"CURRENT","MENU"))
SET XQORM("HIJACK")=^("MENU")
+3 QUIT
