- 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 Feb 18, 2025@23:46:56 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
