- 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 Mar 13, 2025@21:25:19 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
