source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLPOE.m@ 1006

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1PXRMLPOE ; SLC/PJH - Build OE/RR Team from Patient List;07/08/2002
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ; Called from PXRM PATIENT LIST OE/RR protocol
5 ;
6OERR(IENO) ;Copy patient list to OE/RR Team
7 ;
8 ;Check if OK to copy
9 D ASK(IENO,"Copy") Q:$D(DUOUT)!$D(DTOUT)
10 ;
11 N IENN,NNAME,ONAME,TEXT,X,Y
12 ;
13 ;Select OE/RR Team to copy to
14 S TEXT="Select OE/RR TEAM name to copy to: "
15 D OTEAM(.IENN,.NNAME,TEXT) Q:$D(DUOUT)!$D(DTOUT) Q:'IENN
16 ;
17 S ONAME=$P($G(^PXRMXP(810.5,IENO,0)),U)
18 ;
19 ;Load list into ^TMP
20 D LOAD("PXRMRULE",IENO)
21 ;Update OE/RR Team list
22 D UPDLST("PXRMRULE",IENN,NNAME)
23 ;
24 W !!,"Completed copy of patient list '"_ONAME_"'"
25 W !,"into OE/RR Team '"_NNAME_"'",! H 4
26 Q
27 ;
28OK ;Option to overwrite existing list
29 N X,Y,TEXT
30 K DIROUT,DIRUT,DTOUT,DUOUT
31 S DIR(0)="YA0"
32 S DIR("A")="Overwrite existing OE/RR Team list: "
33 S DIR("B")="N"
34 S DIR("?")="Enter Y or N. For detailed help type ??"
35 S DIR("??")=U_"D HELP^PXRMLCR(1)"
36 W !
37 D ^DIR K DIR
38 I $D(DIROUT) S DTOUT=1
39 I $D(DTOUT)!($D(DUOUT)) Q
40 I $E(Y(0))="N" S DUOUT=1 Q
41 Q
42 ;
43ASK(PLIEN,OPT) ;Verify patient list name
44 N X,Y,TEXT
45 K DIROUT,DIRUT,DTOUT,DUOUT
46 S DIR(0)="YA0"
47 S DIR("A")=OPT_" patient list "_$P($G(^PXRMXP(810.5,PLIEN,0)),U)_"?: "
48 S DIR("B")="N"
49 S DIR("?")="Enter Y or N. For detailed help type ??"
50 W !
51 D ^DIR K DIR
52 I $D(DIROUT) S DTOUT=1
53 I $D(DTOUT)!($D(DUOUT)) Q
54 I $E(Y(0))="N" S DUOUT=1 Q
55 Q
56 ;
57 ;
58LOAD(NODE,LIST) ;Load Patient List
59 N DFN,INC,SUB
60 S SUB=0,INC=0
61 K ^TMP(NODE,$J)
62 F S SUB=$O(^PXRMXP(810.5,LIST,30,SUB)) Q:'SUB D
63 .S DFN=$P($G(^PXRMXP(810.5,LIST,30,SUB,0)),U) Q:'DFN
64 .S INC=INC+1,^TMP(NODE,$J,INC)=DFN
65 Q
66 ;
67OTEAM(LIST,NAME,TEXT) ;Select OERR/Team
68 N X,Y,DIC,DIE,DR,DLAYGO
69 W !
70 W !,"To overwrite an existing list you must be the creator of the list and"
71 W !,"the OE/RR team list must be defined as a Team List."
72OT1 S DIC=100.21,DLAYGO=DIC,DIC(0)="QAEMZL"
73 S DIC("S")="I $P($G(^(0)),U,2)=""TM"",$P($G(^(0)),U,5)=DUZ"
74 S DIC("A")=TEXT
75 W !
76 D ^DIC
77 I X="" W !,"An OE/RR Team name must be entered" G OT1
78 I X=(U_U) S DTOUT=1
79 I Y=-1 S DUOUT=1
80 I $D(DTOUT)!$D(DUOUT) Q
81 ;
82 ;Check if OK to overwrite
83 I $P(Y,U,3)'=1 D Q:$D(DTOUT) G:$D(DUOUT) OT1
84 .D OK
85 ;Return list ien
86 S LIST=$P(Y,U),NAME=$P(Y,U,2)
87 Q
88 ;
89UPDLST(NODE,LIST,NAME) ;Update patient list
90 N CNT,DA,DFN,DIK,DUOUT,FDA,MSG,SUB,TEMP
91 ;Lock patient list
92 D LOCK Q:$D(DUOUT)
93 ;
94 ;Clear existing list
95 S SUB=0
96 F S SUB=$O(^OR(100.21,LIST,10,SUB)) Q:'SUB D
97 .S DA=SUB,DA(1)=LIST,DIK="^OR(100.21,"_DA(1)_",10,"
98 .D ^DIK
99 ;
100 ;DBIA #4561 putting data into OE/RR list
101 ;Merge ^TMP into Patient List
102 W !,"Updating "_NAME
103 S DFN=0,CNT=1
104 F S DFN=$O(^TMP(NODE,$J,DFN)) Q:'DFN D
105 .S CNT=CNT+1
106 .S ^TMP("PXRMFDA",$J,100.2101,"?+"_CNT_",?1,",.01)=$G(^TMP(NODE,$J,DFN))_";DPT("
107 ;Update
108 S ^TMP("PXRMFDA",$J,100.21,"?1,",.01)=NAME
109 S ^TMP("PXRMFDA",$J,100.21,"?1,",.1)=$$UP^XLFSTR(NAME)
110 S ^TMP("PXRMFDA",$J,100.21,"?1,",1)="TM"
111 S ^TMP("PXRMFDA",$J,100.21,"?1,",1.6)=DUZ
112 S ^TMP("PXRMFDA",$J,100.21,"?1,",1.65)=$$NOW^XLFDT
113 S TEMP="^TMP(""PXRMFDA"","_$J_")"
114 D UPDATE^DIE("",TEMP,"","MSG")
115 ;Error
116 I $D(MSG) D ERR
117 ;Unlock patient list
118 D UNLOCK
119 K ^TMP(NODE,$J)
120 Q
121 ;
122 ;File locking
123UNLOCK L -^PXRMXP(100.21,LIST) Q
124LOCK L +^PXRMXP(100.21,LIST):0
125 E W !!?5,"Another user is using this OE/RR team list" S DUOUT=1
126 Q
127 ;
128ERR ;Error Handler
129 N ERROR,IC,REF
130 S ERROR(1)="Unable to build patient list : "
131 S ERROR(2)=NAME
132 S ERROR(3)="Error in UPDATE^DIE, needs further investigation"
133 ;Move MSG into ERROR
134 S REF="MSG"
135 F IC=4:1 S REF=$Q(@REF) Q:REF="" S ERROR(IC)=REF_"="_@REF
136 ;Screen message
137 D BMES^XPDUTL(.ERROR)
138 Q
Note: See TracBrowser for help on using the repository browser.