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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCCPU2 3862 printed Dec 13, 2024@02:20:16 Page 2
NURCCPU2 ;HIRMFO/RD/RM-NURSING CARE PLAN UTILITIES (cont.) ;10/30/90
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ; DISCONTINUE ANY ORDERS FOR A PARTICULAR LIST OF ACTIVE INTERVENTIONS
+1 ; UPDATES STATUS (#1) SUBFIELD OF THE ORDER INFO (#4) FIELD OF THE
+2 ; NURS CARE PLAN (#216.8) FILE
+3 if $PIECE(GMRGTERM,"^")=""!GMRGOUT
GOTO Q1
if '$DATA(^GMR(124.3,GMRGPDA,1,"ALIST",$PIECE(GMRGTERM,"^")))
QUIT
SET NURCNT=0
+4 SET NUR2=""
FOR NUR1=0:0
SET NUR2=$ORDER(^GMRD(124.2,$PIECE(GMRGTERM,"^"),1,"AC",NUR2))
if NUR2=""
QUIT
FOR NUR1=0:0
SET NUR1=$ORDER(^GMRD(124.2,$PIECE(GMRGTERM,"^"),1,"AC",NUR2,NUR1))
if NUR1'>0
QUIT
DO GETLIS
YNDC if NURCNT=0
GOTO Q1
SET %=2
WRITE !!,"Do you wish to discontinue any order(s)"
DO YN^DICN
IF %=-1!(%=2)
if %=-1
SET GMRGOUT=1
GOTO Q1
+1 IF '%
WRITE !?5,$CHAR(7),"Answer Yes if want to discontinue some of the above orders",!?5,"else answer No."
GOTO YNDC
CHOOSE DO REPRINT
if GMRGOUT
QUIT
WRITE !!,"Select the numbers of the entry(ies) you wish to discontinue: "
READ NURSDISC:DTIME
if NURSDISC="^"!(NURSDISC="^^")!'$TEST
SET GMRGOUT=1
if NURSDISC=""!GMRGOUT
GOTO Q1
+1 SET NURBAD=0
FOR NURCK=1:1
SET NURSD=$PIECE(NURSDISC,",",NURCK)
if NURSD=""
QUIT
DO CHECK
if NURBAD
QUIT
+2 IF NURBAD
WRITE !?5,$CHAR(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"
GOTO CHOOSE
+3 FOR NURSTERM=0:0
SET NURSTERM=$ORDER(NURSTERM(NURSTERM))
if NURSTERM'>0
QUIT
SET NURORSI=1
DO FILE
Q1 ;
+1 KILL %,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
+2 QUIT
CHECK IF NURSD'?1N.N&(NURSD'?1N.N1"-"1N.N)
SET NURBAD=1
QUIT
+1 SET NURBEG=+NURSD
SET NUREND=$SELECT(NURSD'["-":+NURSD,1:+$PIECE(NURSD,"-",2))
IF (NURBEG<1)!(NUREND<1)!(NUREND<NURBEG)!(NUREND>NURCNT)!(NURBEG>NURCNT)
SET NURBAD=1
QUIT
+2 FOR NURSI=NURBEG:1:NUREND
SET NURSTERM($PIECE(NURORD(NURSI),"^"))=""
+3 QUIT
GETLIS ;
+1 SET NURSCH=$SELECT($DATA(^GMRD(124.2,$PIECE(GMRGTERM,"^"),1,NUR1,0)):$PIECE(^(0),"^",1,2),1:"")
if +NURSCH'>0
QUIT
+2 SET NURSOD=$ORDER(^NURSC(216.8,NURSCPE,"ORD","AA",+NURSCH,0))
SET NURSODA=$SELECT(NURSOD'>0:"",1:$ORDER(^NURSC(216.8,NURSCPE,"ORD","AA",+NURSCH,NURSOD,0)))
+3 IF NURSODA>0
IF $DATA(^NURSC(216.8,NURSCPE,"ORD",NURSODA,0))
IF $PIECE(^(0),"^",3)
QUIT
+4 if $DATA(^GMR(124.3,GMRGPDA,1,"ALIST",+NURSCH))
SET NURCNT=NURCNT+1
SET NURSOR=$ORDER(^GMR(124.3,GMRGPDA,1,"B",+NURSCH,0))
SET NURSORE=$SELECT(NURSOR'>0:"",$DATA(^GMR(124.3,GMRGPDA,1,NURSOR,0)):$PIECE(^(0),"^",2),1:"")
SET NURORD(NURCNT)=NURSCH_"^"_NURSORE
+5 QUIT
REPRINT ;
+1 WRITE !!
SET NURLIN=4
FOR NUR1=0:0
SET NUR1=$ORDER(NURORD(NUR1))
if NUR1'>0
QUIT
SET NURORD=NURORD(NUR1)
DO REPRT
SET GMRGOUT=$SELECT('GMRGOUT!(GMRGOUT=1):0,1:1)
+2 QUIT
REPRT ;
+1 if GMRGOUT
QUIT
IF NURLIN>(IOSL-4)
SET NURLIN=0
WRITE !,"'^' TO STOP: "
READ X:DTIME
SET GMRGOUT=$SELECT(X="^":1,X="^^"!'$TEST:2,1:GMRGOUT)
if GMRGOUT
QUIT
+2 SET NURLIN=NURLIN+1
SET NURPRT=$PIECE(NURORD(NUR1),"^",3)
WRITE !?5,$JUSTIFY(NUR1,2),". "
+3 SET GMRGXPRT=$PIECE(NURORD,"^",2)
SET GMRGXPRT(0)=NURPRT
SET GMRGXPRT(1)="9^"_IOM_"^1^0"
DO EN1^GMRGRUT2
+4 QUIT
EN2 ; IF SELECT ORDERABLE, PUT INFO IN ORDER INFO FIELD (#4) OF THE NURS
+1 ; CARE PLAN (#216.8) FILE
+2 if '$DATA(^GMR(124.3,GMRGPDA,1,"ALIST",$PIECE(GMRGTERM,"^")))!GMRGOUT
QUIT
+3 SET NURSTERM=$PIECE(GMRGTERM,"^")
SET NURSLOAD=$ORDER(^NURSC(216.8,NURSCPE,"ORD","AA",NURSTERM,0))
SET NURSLOAD=$SELECT(NURSLOAD="":"",1:$ORDER(^NURSC(216.8,NURSCPE,"ORD","AA",NURSTERM,NURSLOAD,0)))
SET NURORSI=""
+4 IF NURSLOAD'=""
IF $DATA(^NURSC(216.8,NURSCPE,"ORD",NURSLOAD,0))
if '$PIECE(^(0),"^",3)
GOTO Q2
SET NURORSI=0
+5 DO FILE
Q2 ;
+1 KILL %,DA,NURORSI,NURSGODA,NURSI,NURSJ,NURSLOAD,NURSNUM,NURSNWDT,NURSTERM,NURSZN,X
+2 QUIT
FILE ;
+1 SET DA(1)=NURSCPE
SET NURSNWDT=""
IF '$DATA(^NURSC(216.8,DA(1),"ORD",0))
SET ^(0)="^216.84DI^^"
+2 SET NURSZN=$PIECE(^NURSC(216.8,DA(1),"ORD",0),"^",3,4)
SET DA=$PIECE(NURSZN,"^")+1
SET NURSNUM=$PIECE(NURSZN,"^",2)
FOR DA=DA:1
if '$DATA(^NURSC(216.8,DA(1),"ORD",DA,0))
QUIT
+3 DO NOW^%DTC
SET NURSNWDT=%
SET ^NURSC(216.8,DA(1),"ORD",DA,0)=NURSNWDT_"^"_NURSTERM_"^"_NURORSI
SET $PIECE(^NURSC(216.8,DA(1),"ORD",0),"^",3,4)=DA_"^"_(NURSNUM+1)
SET NURSGODA=DA
+4 FOR NURSJ=1:1
SET X=$PIECE($GET(^NURSC(216.8,DA(1),"ORD",DA,0)),"^",NURSJ)
if X'>0
QUIT
SET DIK="^NURSC(216.8,DA(1),""ORD"","
DO IX1^DIK
KILL DIK
+5 QUIT
