NURCEVE5 ;HIRMFO/RTK,RM-HIGHLIGHT EDITED CARE PLANS ;8/29/96
;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 K NURACPL
S Z=0,GMRGOUT=0
F RVDT=0:0 S RVDT=$O(^GMR(124.3,"AA",DFN,+GMRGRT,RVDT)) Q:RVDT'>0 F NURCPDA=0:0 S NURCPDA=$O(^GMR(124.3,"AA",DFN,+GMRGRT,RVDT,NURCPDA)) Q:NURCPDA'>0 D:'+$G(^GMR(124.3,NURCPDA,5))
. S Z=Z+1,NURACPL(Z)=RVDT_"^"_NURCPDA
. Q
W @IOF,!!,"The following is a list of previous Patient Plans of Care",!
S IOP="HOME" D ^%ZIS S X="IORVON;IORVOFF" D ENDR^%ZISS S GMRGIO("RVOF")=IORVOFF,GMRGIO("RVON")=IORVON,GMRGIO("S")=$L(GMRGIO("RVOF"))&$L(GMRGIO("RVON")) K IORVOFF,IORVON
F J=0:0 S J=$O(NURACPL(J)) Q:J'>0 D Q:GMRGOUT
. W !,$S($D(GMRGPDAA($P(NURACPL(J),"^",2))):"**",1:" "),?5,J,". ",?8
. S Y=9999999-$P(NURACPL(J),"^") D DD^%DT
. D:GMRGIO("S")&$D(GMRGPDAA($P(NURACPL(J),"^",2))) HI(GMRGIO("RVON"))
. S USN=$P($G(^GMR(124.3,$P(NURACPL(J),"^",2),0)),"^",5) W Y," ",$P(^VA(200,USN,0),"^")
. D:GMRGIO("S")&$D(GMRGPDAA($P(NURACPL(J),"^",2))) HI(GMRGIO("RVOF"))
. I $Y>(IOSL-3) W !,"""^"" TO STOP: " R X:DTIME S:X="^" GMRGOUT=1 Q:GMRGOUT W @IOF,!
. Q
S:GMRGOUT GMRGOUT=0
K DIR S DIR(0)="L^1:"_Z,DIR("A")="Enter Selection",DIR("?")="ENTER THE NUMBER (1-"_Z_") OF THE SELECTION TO BE CHOSEN" D ^DIR S GMRGUR=Y
I $D(DIRUT) S GMRGOUT=1 Q
E K GMRGXPRT D
Q1 . S NURSOUT=0 W !!,"Enter a C for a current listing, or an A for a complete listing: " R NURSPLN:DTIME S:NURSPLN="^"!(NURSPLN="^^")!'$T NURSOUT=1 Q:NURSOUT G:NURSPLN="" Q1
. S:NURSPLN?1L NURSPLN=$C($A(NURSPLN)-32) I NURSPLN'="C",NURSPLN'="A" W !?3,$C(7),"Enter a C to get a current listing which will give only the latest date,",!?3,"or an A to get a complete listing with all of the dates" G Q1
. W !!,"This Report may be Queued to print on another device,",!,"Freeing your terminal for other use",!
. S ZTRTN="QUEUED^NURCEVE5",ZTDESC="Nursing CP Print from Eval DT Option" D EN7^NURSUT0 I POP K POP Q
. I '$D(ZTSK) D QUEUED
. Q
Q
HI(ONOFF) ; WILL TURN HIGHLIGHTING ON OR OFF (ONOFF).
S DX=$X,DY=$Y W ONOFF I $X'=DX X:$D(^%ZOSF("XY")) ^("XY")
K DX,DY
Q
QUEUED ;
S NURSOUT=0 F N=1:1:($L(GMRGUR,",")-1) D Q:NURSOUT
. S GMRGPDA=$P(NURACPL($P(GMRGUR,",",N)),"^",2)
. S NURSGMRG=0,NUREDB="P"
. D PRINT2^NURCPPS1
. K NURSGMRG,NUREDB
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCEVE5 2327 printed Nov 22, 2024@17:30:35 Page 2
NURCEVE5 ;HIRMFO/RTK,RM-HIGHLIGHT EDITED CARE PLANS ;8/29/96
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 KILL NURACPL
+1 SET Z=0
SET GMRGOUT=0
+2 FOR RVDT=0:0
SET RVDT=$ORDER(^GMR(124.3,"AA",DFN,+GMRGRT,RVDT))
if RVDT'>0
QUIT
FOR NURCPDA=0:0
SET NURCPDA=$ORDER(^GMR(124.3,"AA",DFN,+GMRGRT,RVDT,NURCPDA))
if NURCPDA'>0
QUIT
if '+$GET(^GMR(124.3,NURCPDA,5))
Begin DoDot:1
+3 SET Z=Z+1
SET NURACPL(Z)=RVDT_"^"_NURCPDA
+4 QUIT
End DoDot:1
+5 WRITE @IOF,!!,"The following is a list of previous Patient Plans of Care",!
+6 SET IOP="HOME"
DO ^%ZIS
SET X="IORVON;IORVOFF"
DO ENDR^%ZISS
SET GMRGIO("RVOF")=IORVOFF
SET GMRGIO("RVON")=IORVON
SET GMRGIO("S")=$LENGTH(GMRGIO("RVOF"))&$LENGTH(GMRGIO("RVON"))
KILL IORVOFF,IORVON
+7 FOR J=0:0
SET J=$ORDER(NURACPL(J))
if J'>0
QUIT
Begin DoDot:1
+8 WRITE !,$SELECT($DATA(GMRGPDAA($PIECE(NURACPL(J),"^",2))):"**",1:" "),?5,J,". ",?8
+9 SET Y=9999999-$PIECE(NURACPL(J),"^")
DO DD^%DT
+10 if GMRGIO("S")&$DATA(GMRGPDAA($PIECE(NURACPL(J),"^",2)))
DO HI(GMRGIO("RVON"))
+11 SET USN=$PIECE($GET(^GMR(124.3,$PIECE(NURACPL(J),"^",2),0)),"^",5)
WRITE Y," ",$PIECE(^VA(200,USN,0),"^")
+12 if GMRGIO("S")&$DATA(GMRGPDAA($PIECE(NURACPL(J),"^",2)))
DO HI(GMRGIO("RVOF"))
+13 IF $Y>(IOSL-3)
WRITE !,"""^"" TO STOP: "
READ X:DTIME
if X="^"
SET GMRGOUT=1
if GMRGOUT
QUIT
WRITE @IOF,!
+14 QUIT
End DoDot:1
if GMRGOUT
QUIT
+15 if GMRGOUT
SET GMRGOUT=0
+16 KILL DIR
SET DIR(0)="L^1:"_Z
SET DIR("A")="Enter Selection"
SET DIR("?")="ENTER THE NUMBER (1-"_Z_") OF THE SELECTION TO BE CHOSEN"
DO ^DIR
SET GMRGUR=Y
+17 IF $DATA(DIRUT)
SET GMRGOUT=1
QUIT
+18 IF '$TEST
KILL GMRGXPRT
Begin DoDot:1
Q1 SET NURSOUT=0
WRITE !!,"Enter a C for a current listing, or an A for a complete listing: "
READ NURSPLN:DTIME
if NURSPLN="^"!(NURSPLN="^^")!'$TEST
SET NURSOUT=1
if NURSOUT
QUIT
if NURSPLN=""
GOTO Q1
+1 if NURSPLN?1L
SET NURSPLN=$CHAR($ASCII(NURSPLN)-32)
IF NURSPLN'="C"
IF NURSPLN'="A"
WRITE !?3,$CHAR(7),"Enter a C to get a current listing which will give only the latest date,",!?3,"or an A to get a complete listing with all of the dates"
GOTO Q1
+2 WRITE !!,"This Report may be Queued to print on another device,",!,"Freeing your terminal for other use",!
+3 SET ZTRTN="QUEUED^NURCEVE5"
SET ZTDESC="Nursing CP Print from Eval DT Option"
DO EN7^NURSUT0
IF POP
KILL POP
QUIT
+4 IF '$DATA(ZTSK)
DO QUEUED
+5 QUIT
End DoDot:1
+6 QUIT
HI(ONOFF) ; WILL TURN HIGHLIGHTING ON OR OFF (ONOFF).
+1 SET DX=$X
SET DY=$Y
WRITE ONOFF
IF $X'=DX
if $DATA(^%ZOSF("XY"))
XECUTE ^("XY")
+2 KILL DX,DY
+3 QUIT
QUEUED ;
+1 SET NURSOUT=0
FOR N=1:1:($LENGTH(GMRGUR,",")-1)
Begin DoDot:1
+2 SET GMRGPDA=$PIECE(NURACPL($PIECE(GMRGUR,",",N)),"^",2)
+3 SET NURSGMRG=0
SET NUREDB="P"
+4 DO PRINT2^NURCPPS1
+5 KILL NURSGMRG,NUREDB
+6 QUIT
End DoDot:1
if NURSOUT
QUIT
+7 QUIT
