- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORLP.m
r613 r623 1 ORLP ; SLC/CLA - Manager for Team List options ; 5/30/08 6:28am 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**47,90,98,243**;Dec 17, 1997;Build 242 3 ; 4 CLEAR ; From TM, MERG^ORLP1, END^ORLP0. 5 K ^XUTL("OR",$J,"ORLP"),^("ORV"),^("ORU"),^("ORW") S ORCNT=0 6 Q 7 ; 8 TM ; From option ORLP TEAM ADD - create/add a team list. 9 N ORLTYP 10 D CLEAR 11 W @IOF,!,"A team list is a list containing patients related to several providers.",!,"These providers are the list's users. You may now create a new team list" 12 W !,"or add autolinks, users and/or patients to an existing team list. Autolinks",!,"automatically add or remove patients with ADT movements. Users on the list" 13 W !,"may receive notifications regarding patients on the same list. Please prefix",!,"your list name with 'TEAM' or 'SERVICE' (e.g. TEAM7B, SERVICECARDIOLOGY.)",! 14 D ASKLIST,END 15 Q 16 ; 17 ASKLIST ; Ask for team list. 18 ; NOTE: For new entries, TYPE field is required and trigger 19 ; stuffs CREATOR field with DUZ of current user. 20 ; 21 AL N DLAYGO,DIC,DIE,DIK,DR,ORFLAG,ORLTNAM,OROWNER,ORROOT,ORDA,ORYY 22 N DIR S DIR(0)="FAO^3:30",DIR("A")="Enter team list name: " 23 D ^DIR 24 I '$D(X)!$D(DIRUT) K DIR,DIRUT Q 25 S ORLTNAM=$$CHKNAM(Y) ; Check for duplication. 26 K DIR 27 N DIC S X=$G(X),(ORROOT,DIC)="^OR(100.21,",DLAYGO=100.21,DIC(0)="LEFQZ" D ^DIC 28 I '$D(X)!(+Y<0)!$D(DIRUT) K DIRUT Q ; User aborted or problem. 29 I +Y,'+$G(^OR(100.21,+Y,11)) S ^OR(100.21,+Y,11)="0^" 30 ; Check for "Personal" lists (and not a new entry): 31 I ORLTNAM>0,(+Y>0),$P($G(^OR(100.21,+Y,0)),U,2)="P" W !!," Personal lists cannot be edited here.",! G AL 32 S (ORYY,TEAM)=Y,ORDA=+Y,TEAM(0)=Y(0),^TMP("ORLP",$J,"TLIST")=+Y K DIC 33 ; Check for entry of team type (new team entry): 34 I $P(TEAM,U,3) D Q 35 .I $P(TEAM(0),U,2)="" D 36 ..SET Y=TEAM,Y(0)=TEAM(0) ; Reassign in case DIE previously called. 37 ..N DIE S DIE=ORROOT,DA=+Y,DR="1 Enter type: ~R" D ^DIE I $O(Y(0)) S DIK=DIE D ^DIK Q 38 .S (ORLTYP,OROWNER)="" 39 .S ORLTYP=$P(^OR(100.21,+TEAM,0),U,2) Q:'$L(ORLTYP) 40 .; Check for "P" type, ask for user/owner input: 41 .I ORLTYP="P" D OWNER^ORLP1 ; Sets OROWNER variable. 42 .I (ORLTYP="P")&(OROWNER="") S DIK=ORROOT,DA=ORDA D ^DIK Q 43 .; 44 .; Allow further editing of autolink type teams: 45 .I ORLTYP["A" S:'$D(^OR(100.21,+TEAM,2,0)) ^(0)="^100.213AVI^^" D Q 46 .. D ASKLINK,ASKUSER,ASKDEV,ASKSUB 47 .; 48 .; Proceed with editing for "TM" type teams: 49 .D ASKPT^ORLP00(+TEAM),ASKUSER,ASKDEV 50 ; 51 ; For existing teams, display team type: 52 W !," Type: "_$S($P(Y(0),U,2)="TM":"Manual Team List",$P(Y(0),U,2)="TA":"Autolinked Team List",$P(Y(0),U,2)="MRAL":"Manual Removal Autolinked Team List",1:"(Unknown)") 53 ; 54 ; Lock before allowing editing: 55 I $O(^OR(100.21,+TEAM,10,0)) L +^OR(100.21,+TEAM):3 I '$T W !?5," Another user is editing this entry." Q 56 ; 57 ; Allow applicable editing for all types but "TM" teams: 58 I $P(TEAM(0),U,2)'="TM" D 59 . D ASKLINK,ASKUSER,ASKDEV 60 . ; 61 . ; Editing of "subscription" attribute for "TA" and "MRAL" teams: 62 . I $P(TEAM(0),U,2)["A" D 63 . . D ASKSUB 64 ; 65 ; Proceed with editing for "TM" type teams: 66 I $P(TEAM(0),U,2)="TM" D ASKPT^ORLP00(+TEAM),ASKUSER,ASKDEV 67 Q 68 ; 69 ASKLINK ; Ask for autolinks. 70 N DIC,DA,DLAYGO,Y,DUOUT,LVP,LVPT,LNAME 71 W ! 72 F K DIC,DA,DUOUT D I LVP<1 Q 73 .S DLAYGO=100.21,DA(1)=+TEAM,DIC="^OR(100.21,"_DA(1)_",2,",DIC(0)="AELMQZ",DIC("A")=" Enter team autolink: " 74 .D ^DIC S LVP=Y I Y<1 Q 75 .I $P($G(Y),U,3)=1 D 76 ..S LNAME=Y(0,0) 77 ..I LVP["VA(200" F D Q:'$D(Y) 78 ...S DA(1)=+TEAM,DIE="^OR(100.21,"_DA(1)_",2,",DA(1)=+TEAM,DA=+LVP,DR="1R" D ^DIE I $D(Y) W !," This field is required in order for Provider autolinks to work correctly.",!," Please answer the question." 79 ..S LVPT=$P($G(^OR(100.21,+TEAM,2,+LVP,0)),U,2) 80 ..; For clinics, take a fork in the road: 81 ..I $P($P(LVP,U,2),";",2)="SC(" D BYCL(LVP) Q 82 ..; For autolinks besides clinics, truck on: 83 ..D ADDLPTS 84 Q 85 ; 86 ADDLPTS ; Add patients linked to autolink. 87 W ! 88 W !," [ADT movements linked to " 89 W !," ",LNAME 90 W !," will now automatically add patients to this list.]" 91 S LINK=$P(LVP,U,2),FILE="^"_$P(LINK,";",2),X="",CNT=0 92 W !!," Adding patients linked to ",LNAME,"..." 93 W ! 94 I FILE="^DIC(42," D LOOPTS("CN",LNAME) Q 95 I FILE="^DG(405.4," D LOOPTS("RM",LNAME) Q 96 I FILE="^VA(200," D Q 97 . ; Variable LVPT determines if provider pointer is for: 98 . ; B - Both Primary and Attending 99 . ; A - Attending 100 . ; P - Primary 101 . I LVPT["B" D LOOPTS("APR",+LINK) N CNTAPR S CNTAPR=CNT,CNT=0 D LOOPTS("AAP",+LINK) Q 102 . I LVPT["P" D LOOPTS("APR",+LINK) Q 103 . I LVPT["A" D LOOPTS("AAP",+LINK) 104 I FILE="^DIC(45.7," D LOOPTS("ATR",+LINK) Q 105 Q 106 ; 107 BYCL(CLINIC) ; SLC/PKS - 6/99 - Return list of clinic patients by enrollment. 108 ; 109 ; Called by ASKLINK. 110 ; 111 ; Variables used: 112 ; 113 ; CLINIC = Clinic to search. 114 ; ORLIST = Array, returned by call to PTCL^SCAPMC. 115 ; ORERR = Array for errors, returned by call to PTCL^SCAPMC. 116 ; ORRET = Flag for problem with PTCL^SCAPMC call. 117 ; RESULT = Holds result of PTCL^SCAPMC call (1=OK, 0=error). 118 ; RCD = Holder for each record in ^TMP of PTCL^SCAPMC. 119 ; DFN = Patient IEN. 120 ; ALCNT = Count of autolink patients added. 121 ; DUPCNT = Count of duplicate patients already on list. 122 ; X = Temp value holder variable. 123 ; 124 N DIC,DA,DO,DD,ORLIST,ORERR,RESULT,RCD,DFN,ALCNT,DUPCNT,X,ORRET 125 ; 126 ; Assign clinic variable: 127 S CLINIC=$P(CLINIC,"^",2) 128 S CLINIC=$P(CLINIC,";") 129 ; 130 ; Keep user informed: 131 W ! 132 W !," [Patient enrollments linked to " 133 W !," ",LNAME 134 W !," will now automatically add patients to this list.]" 135 W ! 136 W !," Adding patients enrolled in ",LNAME,"..." 137 W ! 138 ; 139 ; Process the Autolink entries: 140 K ^TMP("SC TMP LIST") ; Clean up potential leftover data. 141 S ORRET=1 142 S RESULT=$$PTCL^SCAPMC(CLINIC,,.ORLIST,.ORERR) 143 I $L($G(RESULT)) D ; Make sure something was returned. 144 .I RESULT>0 S ORRET=0 ; Was return value 1 or more? 145 I ORRET W !," Error in processing - patients will not be added." Q ; Abort if there's a problem. 146 ; Clinic patients should now be in ^TMP("SC TMP LIST",$J file. 147 ; 148 ; Write the patients to the OE/RR LIST file: 149 S ALCNT=0 ; Initialize autolink counter. 150 S DUPCNT=0 ; Initialize duplicate counter. 151 S RCD=0 ; Initialize to start with first data record. 152 F S RCD=$O(^TMP("SC TMP LIST",$J,RCD)) Q:'RCD D ; Each record. 153 .S DFN=$P(^TMP("SC TMP LIST",$J,RCD),"^") ; Patient IEN. 154 .S X=DFN_";DPT(" ; Add ";DPT(" to patient string. 155 .I $D(^OR(100.21,+TEAM,10,"B",X)) S DUPCNT=DUPCNT+1 Q ; This patient already on list - increment dupe counter. 156 .S:'$D(^OR(100.21,+TEAM,10,0)) ^(0)="^100.2101AV^^" 157 .K DIC,DA,DO,DD 158 .S DA(1)=+TEAM,DIC="^OR(100.21,"_DA(1)_",10,",DIC(0)="L" 159 .D FILE^DICN 160 .I +X S ALCNT=ALCNT+1 ; Increment counter. 161 .Q ; Loop for each record in ^TMP file. 162 ; 163 ; Give user the results: 164 I ALCNT>0 W !," "_ALCNT_" patient(s) added to list." 165 I ALCNT=0 W !," No linked patients found." 166 I DUPCNT>0 W !," "_DUPCNT_" patient(s) already on list." 167 W ! 168 K ^TMP("SC TMP LIST",$J) ; Clean up ^TMP file entries. 169 ; 170 Q 171 ; 172 LOOPTS(REF,DEX) ; 173 S ORLPT=0 F S ORLPT=$O(^DPT(REF,DEX,ORLPT)) Q:ORLPT'>0 S X=ORLPT_";DPT(" D ADDLOOP 174 I $D(LVPT),LVPT["B"!(LVPT']"") Q:REF="APR" 175 I +X W !,$S(+CNT:" "_(+$G(CNTAPR)+(+CNT))_" patient(s) added.",1:" Linked patients already on list.") 176 E W " No linked patients found." 177 W ! 178 K DEX,FILE,MSG,REF,X,Y 179 Q 180 ; 181 ASKUSER ; From ASKLIST - ask for providers/users. 182 Q:$D(DTOUT)!($D(DUOUT)) 183 W ! 184 S:'$D(^OR(100.21,+TEAM,1,0)) ^(0)="^100.212PA^^" 185 K DIC,DA 186 S DLAYGO=100.212,DA(1)=+TEAM 187 S DIC("P")="100.212PA",DIC="^OR(100.21,"_DA(1)_",1,",DIC(0)="AELMQ" 188 S DIC("A")=" Enter team provider/user: " 189 ; SLC/PKS - Next line added on 4/11/2000: 190 S DIC("S")="I $D(X),$D(^VA(200,""AK.PROVIDER"",$P(^(0),U))),$$ACTIVE^XUSER(+Y)" 191 F D Q:Y<1 192 .D ^DIC 193 .I '(Y<1) W ! 194 K DIC,DA,DLAYGO 195 Q 196 ; 197 ASKDEV ; From ASKLIST - ask for device. 198 ; 199 ; New, by PKS - 7/29/99: 200 Q:$D(DTOUT)!($D(DUOUT)) ; Previous interaction fail? 201 W ! 202 N DIE,DR 203 S DIE="^OR(100.21," 204 S DA=+TEAM 205 S DR="1.5 Enter device: " 206 D ^DIE ; Writes to DEVICE field. 207 K DIE 208 Q 209 ; 210 ASKSUB ; From ASKLIST - Ask re: subscription status. 211 ; (PKS - 8/1999) 212 ; 213 Q:$D(DTOUT)!($D(DUOUT)) ; Previous interaction fail? 214 W ! 215 N DIE,DR 216 S DIE="^OR(100.21," 217 S DA=+TEAM 218 S DR="1.7 Enter subscription status: " 219 D ^DIE ; Writes to SUBSCRIBE field. 220 K DIE 221 ; 222 Q 223 ; 224 STOR ; From SEQ^ORLP0 - store list in 100.21. 225 Q:'$D(DUZ)!('ORCNT) 226 I '$D(TEAM),($D(Y)#2) S TEAM=Y 227 S DLAYGO=100.21 228 L +^OR(100.21,+TEAM) 229 S (CNT,ORLI)=0 F ORLJ=1:1 S ORLI=$O(^XUTL("OR",$J,"ORLP",ORLI)) Q:ORLI<1 I $D(^(ORLI,0)) S X=^(0),X=$P(X,U,3) D ADDLOOP 230 I $G(X)>0 S MSG=$S(CNT=0:" Patient(s) already on list.",1:" "_CNT_" patient(s) added.") W !?5,MSG 231 E W !?5," No patients found." 232 I CNT>0 W !?5," Storing list " W:$D(TEAM) $P(TEAM,U,2)," " W "for future reference..." 233 L -^OR(100.12,+TEAM) 234 Q 235 ; 236 ADDLOOP ; From STOR, LOOPTS - add patients. 237 Q:$D(^OR(100.21,+TEAM,10,"B",X)) ; Quit if on list. 238 S:'$D(^OR(100.21,+TEAM,10,0)) ^(0)="^100.2101AV^^" 239 K DIC,DA,DO,DD 240 S DA(1)=+TEAM,DIC="^OR(100.21,"_DA(1)_",10,",DIC(0)="L" 241 D FILE^DICN I Y>0 S:$D(CNT) CNT=CNT+1 242 Q 243 ; 244 CHKNAM(X) ; Check for duplicate entry. 245 N DIC 246 S X=$G(X) 247 S DIC="^OR(100.21," 248 D ^DIC 249 S X=+Y 250 Q X 251 ; 252 END ; 253 I $G(TEAM) L -^OR(100.21,+TEAM) 254 ; 255 END1 K %,CNT,DA,DD,DIC,DO,DIE,DIK,DIR,DR,LINK,ORCNT,ORLI,ORLJ,ORLPT,SEL,TEAM,X,Y,ORBSTG,ORBROOT,DTOUT 256 Q 257 ; 1 ORLP ; SLC/CLA - Manager for Team List options ; [1/12/01 1:54pm] 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**47,90,98**;Dec 17, 1997 3 ; 4 CLEAR ; From TM, MERG^ORLP1, END^ORLP0. 5 K ^XUTL("OR",$J,"ORLP"),^("ORV"),^("ORU"),^("ORW") S ORCNT=0 6 Q 7 ; 8 TM ; From option ORLP TEAM ADD - create/add a team list. 9 N ORLTYP 10 D CLEAR 11 W @IOF,!,"A team list is a list containing patients related to several providers.",!,"These providers are the list's users. You may now create a new team list" 12 W !,"or add autolinks, users and/or patients to an existing team list. Autolinks",!,"automatically add or remove patients with ADT movements. Users on the list" 13 W !,"may receive notifications regarding patients on the same list. Please prefix",!,"your list name with 'TEAM' or 'SERVICE' (e.g. TEAM7B, SERVICECARDIOLOGY.)",! 14 D ASKLIST,END 15 Q 16 ; 17 ASKLIST ; Ask for team list. 18 ; NOTE: For new entries, TYPE field is required and trigger 19 ; stuffs CREATOR field with DUZ of current user. 20 ; 21 AL N DLAYGO,DIC,DIE,DIK,DR,ORFLAG,ORLTNAM,OROWNER,ORROOT,ORDA,ORYY 22 N DIR S DIR(0)="FAO^3:30",DIR("A")="Enter team list name: " 23 D ^DIR 24 I '$D(X)!$D(DIRUT) K DIR,DIRUT Q 25 S ORLTNAM=$$CHKNAM(Y) ; Check for duplication. 26 K DIR 27 N DIC S X=$G(X),(ORROOT,DIC)="^OR(100.21,",DLAYGO=100.21,DIC(0)="LEFQZ" D ^DIC 28 I '$D(X)!(+Y<0)!$D(DIRUT) K DIRUT Q ; User aborted or problem. 29 ; Check for "Personal" lists (and not a new entry): 30 I ORLTNAM>0,(+Y>0),$P($G(^OR(100.21,+Y,0)),U,2)="P" W !!," Personal lists cannot be edited here.",! G AL 31 S (ORYY,TEAM)=Y,ORDA=+Y,TEAM(0)=Y(0),^TMP("ORLP",$J,"TLIST")=+Y K DIC 32 ; Check for entry of team type (new team entry): 33 I $P(TEAM,U,3) D Q 34 .I $P(TEAM(0),U,2)="" D 35 ..SET Y=TEAM,Y(0)=TEAM(0) ; Reassign in case DIE previously called. 36 ..N DIE S DIE=ORROOT,DA=+Y,DR="1 Enter type: ~R" D ^DIE I $O(Y(0)) S DIK=DIE D ^DIK Q 37 .S (ORLTYP,OROWNER)="" 38 .S ORLTYP=$P(^OR(100.21,+TEAM,0),U,2) Q:'$L(ORLTYP) 39 .; Check for "P" type, ask for user/owner input: 40 .I ORLTYP="P" D OWNER^ORLP1 ; Sets OROWNER variable. 41 .I (ORLTYP="P")&(OROWNER="") S DIK=ORROOT,DA=ORDA D ^DIK Q 42 .; 43 .; Allow further editing of autolink type teams: 44 .I ORLTYP["A" S:'$D(^OR(100.21,+TEAM,2,0)) ^(0)="^100.213AVI^^" D Q 45 .. D ASKLINK,ASKUSER,ASKDEV,ASKSUB 46 .; 47 .; Proceed with editing for "TM" type teams: 48 .D ASKPT^ORLP00(+TEAM),ASKUSER,ASKDEV 49 ; 50 ; For existing teams, display team type: 51 W !," Type: "_$S($P(Y(0),U,2)="TM":"Manual Team List",$P(Y(0),U,2)="TA":"Autolinked Team List",$P(Y(0),U,2)="MRAL":"Manual Removal Autolinked Team List",1:"(Unknown)") 52 ; 53 ; Lock before allowing editing: 54 I $O(^OR(100.21,+TEAM,10,0)) L +^OR(100.21,+TEAM):3 I '$T W !?5," Another user is editing this entry." Q 55 ; 56 ; Allow applicable editing for all types but "TM" teams: 57 I $P(TEAM(0),U,2)'="TM" D 58 . D ASKLINK,ASKUSER,ASKDEV 59 . ; 60 . ; Editing of "subscription" attribute for "TA" and "MRAL" teams: 61 . I $P(TEAM(0),U,2)["A" D 62 . . D ASKSUB 63 ; 64 ; Proceed with editing for "TM" type teams: 65 I $P(TEAM(0),U,2)="TM" D ASKPT^ORLP00(+TEAM),ASKUSER,ASKDEV 66 Q 67 ; 68 ASKLINK ; Ask for autolinks. 69 N DIC,DA,DLAYGO,Y,DUOUT,LVP,LVPT,LNAME 70 W ! 71 F K DIC,DA,DUOUT D I LVP<1 Q 72 .S DLAYGO=100.21,DA(1)=+TEAM,DIC="^OR(100.21,"_DA(1)_",2,",DIC(0)="AELMQZ",DIC("A")=" Enter team autolink: " 73 .D ^DIC S LVP=Y I Y<1 Q 74 .I $P($G(Y),U,3)=1 D 75 ..S LNAME=Y(0,0) 76 ..I LVP["VA(200" F D Q:'$D(Y) 77 ...S DA(1)=+TEAM,DIE="^OR(100.21,"_DA(1)_",2,",DA(1)=+TEAM,DA=+LVP,DR="1R" D ^DIE I $D(Y) W !," This field is required in order for Provider autolinks to work correctly.",!," Please answer the question." 78 ..S LVPT=$P($G(^OR(100.21,+TEAM,2,+LVP,0)),U,2) 79 ..; For clinics, take a fork in the road: 80 ..I $P($P(LVP,U,2),";",2)="SC(" D BYCL(LVP) Q 81 ..; For autolinks besides clinics, truck on: 82 ..D ADDLPTS 83 Q 84 ; 85 ADDLPTS ; Add patients linked to autolink. 86 W ! 87 W !," [ADT movements linked to " 88 W !," ",LNAME 89 W !," will now automatically add patients to this list.]" 90 S LINK=$P(LVP,U,2),FILE="^"_$P(LINK,";",2),X="",CNT=0 91 W !!," Adding patients linked to ",LNAME,"..." 92 W ! 93 I FILE="^DIC(42," D LOOPTS("CN",LNAME) Q 94 I FILE="^DG(405.4," D LOOPTS("RM",LNAME) Q 95 I FILE="^VA(200," D Q 96 . ; Variable LVPT determines if provider pointer is for: 97 . ; B - Both Primary and Attending 98 . ; A - Attending 99 . ; P - Primary 100 . I LVPT["B" D LOOPTS("APR",+LINK) N CNTAPR S CNTAPR=CNT,CNT=0 D LOOPTS("AAP",+LINK) Q 101 . I LVPT["P" D LOOPTS("APR",+LINK) Q 102 . I LVPT["A" D LOOPTS("AAP",+LINK) 103 I FILE="^DIC(45.7," D LOOPTS("ATR",+LINK) Q 104 Q 105 ; 106 BYCL(CLINIC) ; SLC/PKS - 6/99 - Return list of clinic patients by enrollment. 107 ; 108 ; Called by ASKLINK. 109 ; 110 ; Variables used: 111 ; 112 ; CLINIC = Clinic to search. 113 ; ORLIST = Array, returned by call to PTCL^SCAPMC. 114 ; ORERR = Array for errors, returned by call to PTCL^SCAPMC. 115 ; ORRET = Flag for problem with PTCL^SCAPMC call. 116 ; RESULT = Holds result of PTCL^SCAPMC call (1=OK, 0=error). 117 ; RCD = Holder for each record in ^TMP of PTCL^SCAPMC. 118 ; DFN = Patient IEN. 119 ; ALCNT = Count of autolink patients added. 120 ; DUPCNT = Count of duplicate patients already on list. 121 ; X = Temp value holder variable. 122 ; 123 N DIC,DA,DO,DD,ORLIST,ORERR,RESULT,RCD,DFN,ALCNT,DUPCNT,X,ORRET 124 ; 125 ; Assign clinic variable: 126 S CLINIC=$P(CLINIC,"^",2) 127 S CLINIC=$P(CLINIC,";") 128 ; 129 ; Keep user informed: 130 W ! 131 W !," [Patient enrollments linked to " 132 W !," ",LNAME 133 W !," will now automatically add patients to this list.]" 134 W ! 135 W !," Adding patients enrolled in ",LNAME,"..." 136 W ! 137 ; 138 ; Process the Autolink entries: 139 K ^TMP("SC TMP LIST") ; Clean up potential leftover data. 140 S ORRET=1 141 S RESULT=$$PTCL^SCAPMC(CLINIC,,.ORLIST,.ORERR) 142 I $L($G(RESULT)) D ; Make sure something was returned. 143 .I RESULT>0 S ORRET=0 ; Was return value 1 or more? 144 I ORRET W !," Error in processing - patients will not be added." Q ; Abort if there's a problem. 145 ; Clinic patients should now be in ^TMP("SC TMP LIST",$J file. 146 ; 147 ; Write the patients to the OE/RR LIST file: 148 S ALCNT=0 ; Initialize autolink counter. 149 S DUPCNT=0 ; Initialize duplicate counter. 150 S RCD=0 ; Initialize to start with first data record. 151 F S RCD=$O(^TMP("SC TMP LIST",$J,RCD)) Q:'RCD D ; Each record. 152 .S DFN=$P(^TMP("SC TMP LIST",$J,RCD),"^") ; Patient IEN. 153 .S X=DFN_";DPT(" ; Add ";DPT(" to patient string. 154 .I $D(^OR(100.21,+TEAM,10,"B",X)) S DUPCNT=DUPCNT+1 Q ; This patient already on list - increment dupe counter. 155 .S:'$D(^OR(100.21,+TEAM,10,0)) ^(0)="^100.2101AV^^" 156 .K DIC,DA,DO,DD 157 .S DA(1)=+TEAM,DIC="^OR(100.21,"_DA(1)_",10,",DIC(0)="L" 158 .D FILE^DICN 159 .I +X S ALCNT=ALCNT+1 ; Increment counter. 160 .Q ; Loop for each record in ^TMP file. 161 ; 162 ; Give user the results: 163 I ALCNT>0 W !," "_ALCNT_" patient(s) added to list." 164 I ALCNT=0 W !," No linked patients found." 165 I DUPCNT>0 W !," "_DUPCNT_" patient(s) already on list." 166 W ! 167 K ^TMP("SC TMP LIST",$J) ; Clean up ^TMP file entries. 168 ; 169 Q 170 ; 171 LOOPTS(REF,DEX) ; 172 S ORLPT=0 F S ORLPT=$O(^DPT(REF,DEX,ORLPT)) Q:ORLPT'>0 S X=ORLPT_";DPT(" D ADDLOOP 173 I $D(LVPT),LVPT["B"!(LVPT']"") Q:REF="APR" 174 I +X W !,$S(+CNT:" "_(+$G(CNTAPR)+(+CNT))_" patient(s) added.",1:" Linked patients already on list.") 175 E W " No linked patients found." 176 W ! 177 K DEX,FILE,MSG,REF,X,Y 178 Q 179 ; 180 ASKUSER ; From ASKLIST - ask for providers/users. 181 Q:$D(DTOUT)!($D(DUOUT)) 182 W ! 183 S:'$D(^OR(100.21,+TEAM,1,0)) ^(0)="^100.212PA^^" 184 K DIC,DA 185 S DLAYGO=100.212,DA(1)=+TEAM 186 S DIC("P")="100.212PA",DIC="^OR(100.21,"_DA(1)_",1,",DIC(0)="AELMQ" 187 S DIC("A")=" Enter team provider/user: " 188 ; SLC/PKS - Next line added on 4/11/2000: 189 S DIC("S")="I $D(X),$D(^VA(200,""AK.PROVIDER"",$P(^(0),U))),$$ACTIVE^XUSER(+Y)" 190 F D Q:Y<1 191 .D ^DIC 192 .I '(Y<1) W ! 193 K DIC,DA,DLAYGO 194 Q 195 ; 196 ASKDEV ; From ASKLIST - ask for device. 197 ; 198 ; New, by PKS - 7/29/99: 199 Q:$D(DTOUT)!($D(DUOUT)) ; Previous interaction fail? 200 W ! 201 N DIE,DR 202 S DIE="^OR(100.21," 203 S DA=+TEAM 204 S DR="1.5 Enter device: " 205 D ^DIE ; Writes to DEVICE field. 206 K DIE 207 Q 208 ; 209 ASKSUB ; From ASKLIST - Ask re: subscription status. 210 ; (PKS - 8/1999) 211 ; 212 Q:$D(DTOUT)!($D(DUOUT)) ; Previous interaction fail? 213 W ! 214 N DIE,DR 215 S DIE="^OR(100.21," 216 S DA=+TEAM 217 S DR="1.7 Enter subscription status: " 218 D ^DIE ; Writes to SUBSCRIBE field. 219 K DIE 220 ; 221 Q 222 ; 223 STOR ; From SEQ^ORLP0 - store list in 100.21. 224 Q:'$D(DUZ)!('ORCNT) 225 I '$D(TEAM),($D(Y)#2) S TEAM=Y 226 S DLAYGO=100.21 227 L +^OR(100.21,+TEAM) 228 S (CNT,ORLI)=0 F ORLJ=1:1 S ORLI=$O(^XUTL("OR",$J,"ORLP",ORLI)) Q:ORLI<1 I $D(^(ORLI,0)) S X=^(0),X=$P(X,U,3) D ADDLOOP 229 I $G(X)>0 S MSG=$S(CNT=0:" Patient(s) already on list.",1:" "_CNT_" patient(s) added.") W !?5,MSG 230 E W !?5," No patients found." 231 I CNT>0 W !?5," Storing list " W:$D(TEAM) $P(TEAM,U,2)," " W "for future reference..." 232 L -^OR(100.12,+TEAM) 233 Q 234 ; 235 ADDLOOP ; From STOR, LOOPTS - add patients. 236 Q:$D(^OR(100.21,+TEAM,10,"B",X)) ; Quit if on list. 237 S:'$D(^OR(100.21,+TEAM,10,0)) ^(0)="^100.2101AV^^" 238 K DIC,DA,DO,DD 239 S DA(1)=+TEAM,DIC="^OR(100.21,"_DA(1)_",10,",DIC(0)="L" 240 D FILE^DICN I Y>0 S:$D(CNT) CNT=CNT+1 241 Q 242 ; 243 CHKNAM(X) ; Check for duplicate entry. 244 N DIC 245 S X=$G(X) 246 S DIC="^OR(100.21," 247 D ^DIC 248 S X=+Y 249 Q X 250 ; 251 END ; 252 I $G(TEAM) L -^OR(100.21,+TEAM) 253 ; 254 END1 K %,CNT,DA,DD,DIC,DO,DIE,DIK,DIR,DR,LINK,ORCNT,ORLI,ORLJ,ORLPT,SEL,TEAM,X,Y,ORBSTG,ORBROOT,DTOUT 255 Q 256 ;
Note:
See TracChangeset
for help on using the changeset viewer.
