source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURCCPU2.m@ 1578

NURCCPU2 ;HIRMFO/RD/RM-NURSING CARE PLAN UTILITIES  (cont.) ;10/30/90
 ;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ; DISCONTINUE ANY ORDERS FOR A PARTICULAR LIST OF ACTIVE INTERVENTIONS
 ; UPDATES STATUS (#1) SUBFIELD OF THE ORDER INFO (#4) FIELD OF THE
 ; NURS CARE PLAN (#216.8) FILE
 G:$P(GMRGTERM,"^")=""!GMRGOUT Q1 Q:'$D(^GMR(124.3,GMRGPDA,1,"ALIST",$P(GMRGTERM,"^")))  S NURCNT=0
 S NUR2="" F NUR1=0:0 S NUR2=$O(^GMRD(124.2,$P(GMRGTERM,"^"),1,"AC",NUR2)) Q:NUR2=""  F NUR1=0:0 S NUR1=$O(^GMRD(124.2,$P(GMRGTERM,"^"),1,"AC",NUR2,NUR1)) Q:NUR1'>0  D GETLIS
YNDC G:NURCNT=0 Q1 S %=2 W !!,"Do you wish to discontinue any order(s)" D YN^DICN I %=-1!(%=2) S:%=-1 GMRGOUT=1 G Q1
 I '% W !?5,$C(7),"Answer Yes if want to discontinue some of the above orders",!?5,"else answer No." G YNDC
CHOOSE D REPRINT Q:GMRGOUT  W !!,"Select the numbers of the entry(ies) you wish to discontinue: " R NURSDISC:DTIME S:NURSDISC="^"!(NURSDISC="^^")!'$T GMRGOUT=1 G:NURSDISC=""!GMRGOUT Q1
 S NURBAD=0 F NURCK=1:1 S NURSD=$P(NURSDISC,",",NURCK) Q:NURSD=""  D CHECK Q:NURBAD
 I NURBAD W !?5,$C(7),"Please enter numeric selection or up-arrow to quit. ",!,?5,"Format: { 1 } or { 1,2,3,...} or { 2-7 } or { 2,3,7-9 } or { ^ } to quit" G CHOOSE
 F NURSTERM=0:0 S NURSTERM=$O(NURSTERM(NURSTERM)) Q:NURSTERM'>0  S NURORSI=1 D FILE
Q1 ;
 K %,DA,NUR1,NUR2,NURBAD,NURBEG,NURCNT,NURCK,NUREND,NURLIN,NURORD,NURORSI,NURPRT,NURSCH,NURSD,NURSDISC,NURSGODA,NURSI,NURSJ,NURSNUM,NURSNWDT,NURSOD,NURSODA,NURSOR,NURSORE,NURSTERM,NURSZN,X
 Q
CHECK I NURSD'?1N.N&(NURSD'?1N.N1"-"1N.N) S NURBAD=1 Q
 S NURBEG=+NURSD,NUREND=$S(NURSD'["-":+NURSD,1:+$P(NURSD,"-",2)) I (NURBEG<1)!(NUREND<1)!(NUREND<NURBEG)!(NUREND>NURCNT)!(NURBEG>NURCNT) S NURBAD=1 Q
 F NURSI=NURBEG:1:NUREND S NURSTERM($P(NURORD(NURSI),"^"))=""
 Q
GETLIS ;
 S NURSCH=$S($D(^GMRD(124.2,$P(GMRGTERM,"^"),1,NUR1,0)):$P(^(0),"^",1,2),1:"") Q:+NURSCH'>0
 S NURSOD=$O(^NURSC(216.8,NURSCPE,"ORD","AA",+NURSCH,0)),NURSODA=$S(NURSOD'>0:"",1:$O(^NURSC(216.8,NURSCPE,"ORD","AA",+NURSCH,NURSOD,0)))
 I NURSODA>0,$D(^NURSC(216.8,NURSCPE,"ORD",NURSODA,0)),$P(^(0),"^",3) Q
 S:$D(^GMR(124.3,GMRGPDA,1,"ALIST",+NURSCH)) NURCNT=NURCNT+1,NURSOR=$O(^GMR(124.3,GMRGPDA,1,"B",+NURSCH,0)),NURSORE=$S(NURSOR'>0:"",$D(^GMR(124.3,GMRGPDA,1,NURSOR,0)):$P(^(0),"^",2),1:""),NURORD(NURCNT)=NURSCH_"^"_NURSORE
 Q
REPRINT ;
 W !! S NURLIN=4 F NUR1=0:0 S NUR1=$O(NURORD(NUR1)) Q:NUR1'>0  S NURORD=NURORD(NUR1) D REPRT S GMRGOUT=$S('GMRGOUT!(GMRGOUT=1):0,1:1)
 Q
REPRT ;
 Q:GMRGOUT  I NURLIN>(IOSL-4) S NURLIN=0 W !,"'^' TO STOP: " R X:DTIME S GMRGOUT=$S(X="^":1,X="^^"!'$T:2,1:GMRGOUT) Q:GMRGOUT
 S NURLIN=NURLIN+1,NURPRT=$P(NURORD(NUR1),"^",3) W !?5,$J(NUR1,2),". "
 S GMRGXPRT=$P(NURORD,"^",2),GMRGXPRT(0)=NURPRT,GMRGXPRT(1)="9^"_IOM_"^1^0" D EN1^GMRGRUT2
 Q
EN2 ; IF SELECT ORDERABLE, PUT INFO IN ORDER INFO FIELD (#4) OF THE NURS
 ; CARE PLAN (#216.8) FILE
 Q:'$D(^GMR(124.3,GMRGPDA,1,"ALIST",$P(GMRGTERM,"^")))!GMRGOUT
 S NURSTERM=$P(GMRGTERM,"^"),NURSLOAD=$O(^NURSC(216.8,NURSCPE,"ORD","AA",NURSTERM,0)),NURSLOAD=$S(NURSLOAD="":"",1:$O(^NURSC(216.8,NURSCPE,"ORD","AA",NURSTERM,NURSLOAD,0))) S NURORSI=""
 I NURSLOAD'="",$D(^NURSC(216.8,NURSCPE,"ORD",NURSLOAD,0)) G:'$P(^(0),"^",3) Q2 S NURORSI=0
 D FILE
Q2 ;
 K %,DA,NURORSI,NURSGODA,NURSI,NURSJ,NURSLOAD,NURSNUM,NURSNWDT,NURSTERM,NURSZN,X
 Q
FILE ;
 S DA(1)=NURSCPE,NURSNWDT="" I '$D(^NURSC(216.8,DA(1),"ORD",0)) S ^(0)="^216.84DI^^"
 S NURSZN=$P(^NURSC(216.8,DA(1),"ORD",0),"^",3,4),DA=$P(NURSZN,"^")+1,NURSNUM=$P(NURSZN,"^",2) F DA=DA:1 Q:'$D(^NURSC(216.8,DA(1),"ORD",DA,0))
 D NOW^%DTC S NURSNWDT=%,^NURSC(216.8,DA(1),"ORD",DA,0)=NURSNWDT_"^"_NURSTERM_"^"_NURORSI,$P(^NURSC(216.8,DA(1),"ORD",0),"^",3,4)=DA_"^"_(NURSNUM+1),NURSGODA=DA
 F NURSJ=1:1 S X=$P($G(^NURSC(216.8,DA(1),"ORD",DA,0)),"^",NURSJ) Q:X'>0  S DIK="^NURSC(216.8,DA(1),""ORD""," D IX1^DIK K DIK
 Q