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

ORCPROB.m

Go to the documentation of this file.
  1. 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
  1. ADD ; -- add new problem
  1. N GMPLIST,ORPROV
  1. D FULL^VALM1 S VALMBCK="R",ORPROV=$$PROVIDER Q:ORPROV="^"
  1. S:'$G(ORL) ORL=$$LOCATION^ORCMENU1 Q:'ORL
  1. D ADD^GMPLUTL2(+ORVP,+ORL,ORPROV)
  1. D:$O(GMPLIST(0)) TAB^ORCHART(ORTAB,1)
  1. Q
  1. ;
  1. EDIT ; -- edit problem
  1. N GMPLIST,ORPROV,PIECE,NMBR,IFN S VALMBCK=""
  1. I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("edit") Q:'ORNMBR
  1. D FULL^VALM1 S VALMBCK="R",ORPROV=$$PROVIDER Q:ORPROV="^"
  1. S:'$G(ORL) ORL=$$LOCATION^ORCMENU1 Q:'ORL
  1. F PIECE=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",PIECE) I NMBR D
  1. . S IFN=+$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
  1. . I 'IFN W !,"Problem #"_NMBR_" has been removed!",! H 1 Q
  1. . K GMPLIST D EDIT^GMPLUTL2(+ORVP,+ORL,ORPROV,IFN)
  1. . S:$D(GMPLIST) OREBUILD=1
  1. Q
  1. ;
  1. INACT ; -- inactivate a problem
  1. N ORPROV,ORPL,ORY,NUM,NMBR,PIECE,IFN,STS S VALMBCK=""
  1. I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("inactivate") Q:'ORNMBR
  1. S NUM=$L(ORNMBR,",")-1 Q:'$$OK("inactivate",NUM)
  1. S ORPROV=$$PROVIDER Q:ORPROV="^"
  1. F PIECE=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",PIECE) I NMBR D
  1. . S IFN=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR)),STS=$P(IFN,U,4),IFN=+IFN
  1. . I 'IFN W !,"Problem #"_NMBR_" has been removed!",! H 1 Q
  1. . I STS="I" W !,"Problem #"_NMBR_" is already inactive!",! H 1 Q
  1. . S ORPL("PROVIDER")=ORPROV,ORPL("STATUS")="I",ORPL("PROBLEM")=IFN
  1. . W !,$$PROBTEXT^GMPLX(IFN)
  1. . D UPDATE^GMPLUTL(.ORPL,.ORY) I ORY'>0 W !?5,"ERROR - "_ORY(0) H 1 Q
  1. . W:$X>64 !?5 W " ... inactivated" H 1 S OREBUILD=1
  1. . S $P(^TMP("OR",$J,"CURRENT","IDX",NMBR),U,4)="I"
  1. Q
  1. ;
  1. CMMT ; -- comment problem
  1. N DIR,X,Y,ORPL,ORY,NMBR,PIECE,QUIT,TEXT,ORPROV,CMMT S VALMBCK=""
  1. I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") Q:'ORNMBR
  1. D FULL^VALM1 S VALMBCK="R",ORPROV=$$PROVIDER Q:ORPROV="^"
  1. S CMMT=+$P($P($G(^TMP("OR",$J,ORTAB,0)),U,3),";",4) ;show comments
  1. F PIECE=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",PIECE) I NMBR D Q:$D(QUIT)
  1. . S IFN=+$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
  1. . I 'IFN W !,"Problem #"_NMBR_" has been removed!",! H 2 Q
  1. . S DIR(0)="FAO^1:60",DIR("A")="COMMENT (<60 char): "
  1. . S DIR("A",1)=$$UP^XLFSTR($$PROBTEXT^GMPLX(IFN))
  1. . S DIR("?")="Enter up to 60 characters of additional text to be appended to this problem" S:$D(TEXT) DIR("B")=TEXT
  1. . W ! D ^DIR I $D(DTOUT)!("^"[Y) S QUIT=1 Q
  1. . S (TEXT,ORPL("COMMENT"))=Y,ORPL("PROBLEM")=IFN
  1. . S ORPL("PROVIDER")=ORPROV
  1. . D UPDATE^GMPLUTL(.ORPL,.ORY) S:CMMT&(ORY>0) OREBUILD=1
  1. . W !?5,$S(ORY>0:"... 1 comment added",1:"ERROR - "_ORY(0)) H 1
  1. Q
  1. ;
  1. REMOVE ; -- remove problem
  1. N DIR,X,Y,IFN,TEXT,ORY,SUB,NUM,NMBR,PIECE,QUIT,ORPROV S VALMBCK=""
  1. I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("remove") Q:'ORNMBR
  1. S NUM=$L(ORNMBR,",")-1 Q:'$$OK("remove",NUM)
  1. D FULL^VALM1 S VALMBCK="R",ORPROV=$$PROVIDER Q:ORPROV="^"
  1. F PIECE=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",PIECE) I NMBR D Q:$D(QUIT)
  1. . S IFN=+$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
  1. . I 'IFN W !,"Problem #"_NMBR_" has already been removed!",! H 1 Q
  1. . S DIR(0)="FAO^1:60",DIR("A")="REASON FOR REMOVAL: "
  1. . S DIR("A",1)=$$UP^XLFSTR($$PROBTEXT^GMPLX(IFN))
  1. . S:$D(TEXT) DIR("B")=TEXT
  1. . S DIR("?")="Enter up to 60 characters of additional text to be appended to this problem"
  1. . W ! D ^DIR I $D(DTOUT)!($D(DUOUT)) S QUIT=1 Q
  1. . S TEXT=Y D REMOVE^GMPLUTL2(IFN,ORPROV,TEXT,.ORY)
  1. . I ORY'>0 W !?5,"ERROR - "_ORY(0) H 1 Q
  1. . W !?5,"... removed" H 1 S OREBUILD=1
  1. Q
  1. ;
  1. VERIFY ; -- verify problem
  1. I '$P($$PARAM^GMPLUTL2,U,2) W !,"This action is not in use.",! H 1 Q
  1. 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
  1. N NUM,PIECE,GMPIFN,OROLD S VALMBCK=""
  1. I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("verify") Q:'ORNMBR
  1. S VALMBCK="",NUM=$L(ORNMBR,",")-1 Q:'$$OK("verify",NUM)
  1. F PIECE=1:1:$L(ORNMBR,",") S NUM=$P(ORNMBR,",",PIECE) I NUM D
  1. . S GMPIFN=+$G(^TMP("OR",$J,"CURRENT","IDX",NUM))
  1. . I 'GMPIFN W !,"Problem #"_NUM_" has already been removed!",! H 1 Q
  1. . S OROLD=$G(^AUPNPROB(GMPIFN,1)) D VERIFY^GMPL1
  1. . S:OROLD'=$G(^AUPNPROB(GMPIFN,1)) OREBUILD=1
  1. Q
  1. ;
  1. OK(ACTION,NUM) ; -- Are you sure?
  1. N DIR,X,Y
  1. S DIR(0)="YA",DIR("B")="NO",DIR("A")="Are you sure you want to "_ACTION_" "_$S(NUM>1:"these problems? ",1:"this problem? ")
  1. S DIR("?")="Enter YES to continue with this action, or NO to cancel"
  1. D ^DIR
  1. Q +Y
  1. ;
  1. PROVIDER() ; --Return Responsible Provider
  1. N X,Y,DIC
  1. I '$D(^XUSEC("OREMAS",DUZ)),'$G(ORNP)!($G(ORNP)=DUZ) S Y=DUZ_U_$P($G(^VA(200,DUZ,0)),U) G PVQ
  1. S DIC=200,DIC(0)="AEQM",DIC("A")="Requesting Clinician: "
  1. S:$G(ORNP) DIC("B")=ORNP D ^DIC S:Y'>0 Y="^"
  1. PVQ Q Y
  1. ;
  1. EX ; -- exit action
  1. D:$G(OREBUILD) TAB^ORCHART(ORTAB,1)
  1. S:$D(^TMP("OR",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
  1. Q