source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCPROB.m@ 808

Last change on this file since 808 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1ORCPROB ; SLC/MKB/REV - Problem List interface ;03/11/03 14:03
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**27,48,181**;Dec 17, 1997
3ADD ; -- add new problem
4 N GMPLIST,ORPROV
5 D FULL^VALM1 S VALMBCK="R",ORPROV=$$PROVIDER Q:ORPROV="^"
6 S:'$G(ORL) ORL=$$LOCATION^ORCMENU1 Q:'ORL
7 D ADD^GMPLUTL2(+ORVP,+ORL,ORPROV)
8 D:$O(GMPLIST(0)) TAB^ORCHART(ORTAB,1)
9 Q
10 ;
11EDIT ; -- edit problem
12 N GMPLIST,ORPROV,PIECE,NMBR,IFN S VALMBCK=""
13 I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("edit") Q:'ORNMBR
14 D FULL^VALM1 S VALMBCK="R",ORPROV=$$PROVIDER Q:ORPROV="^"
15 S:'$G(ORL) ORL=$$LOCATION^ORCMENU1 Q:'ORL
16 F PIECE=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",PIECE) I NMBR D
17 . S IFN=+$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
18 . I 'IFN W !,"Problem #"_NMBR_" has been removed!",! H 1 Q
19 . K GMPLIST D EDIT^GMPLUTL2(+ORVP,+ORL,ORPROV,IFN)
20 . S:$D(GMPLIST) OREBUILD=1
21 Q
22 ;
23INACT ; -- inactivate a problem
24 N ORPROV,ORPL,ORY,NUM,NMBR,PIECE,IFN,STS S VALMBCK=""
25 I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("inactivate") Q:'ORNMBR
26 S NUM=$L(ORNMBR,",")-1 Q:'$$OK("inactivate",NUM)
27 S ORPROV=$$PROVIDER Q:ORPROV="^"
28 F PIECE=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",PIECE) I NMBR D
29 . S IFN=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR)),STS=$P(IFN,U,4),IFN=+IFN
30 . I 'IFN W !,"Problem #"_NMBR_" has been removed!",! H 1 Q
31 . I STS="I" W !,"Problem #"_NMBR_" is already inactive!",! H 1 Q
32 . S ORPL("PROVIDER")=ORPROV,ORPL("STATUS")="I",ORPL("PROBLEM")=IFN
33 . W !,$$PROBTEXT^GMPLX(IFN)
34 . D UPDATE^GMPLUTL(.ORPL,.ORY) I ORY'>0 W !?5,"ERROR - "_ORY(0) H 1 Q
35 . W:$X>64 !?5 W " ... inactivated" H 1 S OREBUILD=1
36 . S $P(^TMP("OR",$J,"CURRENT","IDX",NMBR),U,4)="I"
37 Q
38 ;
39CMMT ; -- comment problem
40 N DIR,X,Y,ORPL,ORY,NMBR,PIECE,QUIT,TEXT,ORPROV,CMMT S VALMBCK=""
41 I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") Q:'ORNMBR
42 D FULL^VALM1 S VALMBCK="R",ORPROV=$$PROVIDER Q:ORPROV="^"
43 S CMMT=+$P($P($G(^TMP("OR",$J,ORTAB,0)),U,3),";",4) ;show comments
44 F PIECE=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",PIECE) I NMBR D Q:$D(QUIT)
45 . S IFN=+$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
46 . I 'IFN W !,"Problem #"_NMBR_" has been removed!",! H 2 Q
47 . I '$$CODESTS^GMPLX(IFN,DT) D Q
48 . . W !,"Problem #"_NMBR_" has an inactive code. Please use the EDIT action instead",! H 2 S QUIT=1
49 . S DIR(0)="FAO^1:60",DIR("A")="COMMENT (<60 char): "
50 . S DIR("A",1)=$$UP^XLFSTR($$PROBTEXT^GMPLX(IFN))
51 . S DIR("?")="Enter up to 60 characters of additional text to be appended to this problem" S:$D(TEXT) DIR("B")=TEXT
52 . W ! D ^DIR I $D(DTOUT)!("^"[Y) S QUIT=1 Q
53 . S (TEXT,ORPL("COMMENT"))=Y,ORPL("PROBLEM")=IFN
54 . S ORPL("PROVIDER")=ORPROV
55 . D UPDATE^GMPLUTL(.ORPL,.ORY) S:CMMT&(ORY>0) OREBUILD=1
56 . W !?5,$S(ORY>0:"... 1 comment added",1:"ERROR - "_ORY(0)) H 1
57 Q
58 ;
59REMOVE ; -- remove problem
60 N DIR,X,Y,IFN,TEXT,ORY,SUB,NUM,NMBR,PIECE,QUIT,ORPROV S VALMBCK=""
61 I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("remove") Q:'ORNMBR
62 S NUM=$L(ORNMBR,",")-1 Q:'$$OK("remove",NUM)
63 D FULL^VALM1 S VALMBCK="R",ORPROV=$$PROVIDER Q:ORPROV="^"
64 F PIECE=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",PIECE) I NMBR D Q:$D(QUIT)
65 . S IFN=+$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
66 . I 'IFN W !,"Problem #"_NMBR_" has already been removed!",! H 1 Q
67 . S DIR(0)="FAO^1:60",DIR("A")="REASON FOR REMOVAL: "
68 . S DIR("A",1)=$$UP^XLFSTR($$PROBTEXT^GMPLX(IFN))
69 . S:$D(TEXT) DIR("B")=TEXT
70 . S DIR("?")="Enter up to 60 characters of additional text to be appended to this problem"
71 . W ! D ^DIR I $D(DTOUT)!($D(DUOUT)) S QUIT=1 Q
72 . S TEXT=Y D REMOVE^GMPLUTL2(IFN,ORPROV,TEXT,.ORY)
73 . I ORY'>0 W !?5,"ERROR - "_ORY(0) H 1 Q
74 . W !?5,"... removed" H 1 S OREBUILD=1
75 Q
76 ;
77VERIFY ; -- verify problem
78 I '$P($$PARAM^GMPLUTL2,U,2) W !,"This action is not in use.",! H 1 Q
79 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
80 N NUM,PIECE,GMPIFN,OROLD S VALMBCK=""
81 I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("verify") Q:'ORNMBR
82 S VALMBCK="",NUM=$L(ORNMBR,",")-1 Q:'$$OK("verify",NUM)
83 F PIECE=1:1:$L(ORNMBR,",") S NUM=$P(ORNMBR,",",PIECE) I NUM D
84 . S GMPIFN=+$G(^TMP("OR",$J,"CURRENT","IDX",NUM))
85 . I 'GMPIFN W !,"Problem #"_NUM_" has already been removed!",! H 1 Q
86 . S OROLD=$G(^AUPNPROB(GMPIFN,1)) D VERIFY^GMPL1
87 . S:OROLD'=$G(^AUPNPROB(GMPIFN,1)) OREBUILD=1
88 Q
89 ;
90OK(ACTION,NUM) ; -- Are you sure?
91 N DIR,X,Y
92 S DIR(0)="YA",DIR("B")="NO",DIR("A")="Are you sure you want to "_ACTION_" "_$S(NUM>1:"these problems? ",1:"this problem? ")
93 S DIR("?")="Enter YES to continue with this action, or NO to cancel"
94 D ^DIR
95 Q +Y
96 ;
97PROVIDER() ; --Return Responsible Provider
98 N X,Y,DIC
99 I '$D(^XUSEC("OREMAS",DUZ)),'$G(ORNP)!($G(ORNP)=DUZ) S Y=DUZ_U_$P($G(^VA(200,DUZ,0)),U) G PVQ
100 S DIC=200,DIC(0)="AEQM",DIC("A")="Requesting Clinician: "
101 S:$G(ORNP) DIC("B")=ORNP D ^DIC S:Y'>0 Y="^"
102PVQ Q Y
103 ;
104EX ; -- exit action
105 D:$G(OREBUILD) TAB^ORCHART(ORTAB,1)
106 S:$D(^TMP("OR",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
107 Q
Note: See TracBrowser for help on using the repository browser.