- 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 Jan 18, 2025@03:30:06 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