50 lines
3.7 KiB
Mathematica
50 lines
3.7 KiB
Mathematica
|
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
|