- NURCPPS1 ;HIRMFO/RM,RK-NURSING CARE PLAN REPORT USING GENERIC SORT ;8/29/96
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- EN1 ; ENTRY FROM OPTION NURCPE-CARE
- Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
- S GMRGRT=$O(^GMRD(124.2,"AA","NURSC",2,"Nursing Care Plan",1,0)),GMRGRT=GMRGRT_"^Nursing Care Plan" I +GMRGRT'>0 W !,"The ""AA"" crossreference for file 124.2 needs to be re-crossreferenced." G QUIT
- S (NURSGMRG,NURSOUT)=0,GMRGOUT=0
- ASK ; GET PATIENT/ GROUP OF PATIENTS
- S NACT=0 D WARDPAT^NURCUT0 S:NURQUIT NURSOUT=1 K DIC,NPWARD,NURQUIT G QUIT:NURSOUT
- I "Pp"[NUREDB S GMRGXPRT="1^0^0" D EN1^GMRGRUT3 S:GMRGOUT NURSOUT=1 K GMRGOUT,GMRGXPRT G QUIT:NURSOUT,ASK:$G(GMRGPDA)'>0
- REASK ; SELECT CURRENT OR COMPLETE LISTING
- W !!,"Enter a C for a current listing, or an A for a complete listing: " R NURSPLN:DTIME S:NURSPLN="^"!(NURSPLN="^^")!'$T NURSOUT=1 G QUIT:NURSOUT,ASK:NURSPLN=""
- 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 only give the latest dates,",!?3,"or an A to get a complete listing with all of the dates" G REASK
- ;
- W !!,"This Report may be Queued to print on another device,",!,"freeing your terminal for other use.",!
- S GMRGPDT="N" F X="DFN","GMRGPDA","GMRGRT","NRMBD(","NURSPLN","NUREDB","NURWARD","NURSGMRG" S ZTSAVE(X)=""
- S ZTDESC="Patient Care Plan Print",ZTRTN="REPORT^NURCPPS1" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
- ;
- REPORT ; PRINT THESE REPORTS
- D:'$D(ZTQUEUED) WAIT^DICD U IO
- K ^TMP($J,"NURCEN") D ^NURCAS2 K NURWARD,NRMBD,DFN
- I '$D(^TMP($J,"NURCEN")) W $C(7),!,"NO PATIENTS WERE SELECTED." G ASK:'$D(ZTQUEUED),QUIT
- PRINT ;PRINT ROUTINE
- S NURSOUT=0,NBED="" F S NBED=$O(^TMP($J,"NURCEN",NBED)) Q:NBED=""!NURSOUT D
- . S NBED(0)=""
- . F S NBED(0)=$O(^TMP($J,"NURCEN",NBED,NBED(0))) Q:NBED(0)=""!NURSOUT D
- . . S N1=""
- . . F S N1=$O(^TMP($J,"NURCEN",NBED,NBED(0),N1)) Q:N1=""!NURSOUT D PRINT1
- . . Q
- . Q
- QUIT ; KILL LOCAL VARIABLES
- D ^%ZISC I $D(ZTQUEUED) S ZTREQ="@"
- I 'NURSGMRG K NURSGMRG,NURSPLN,DFN,GMRGPDA,GMRGRT,GMRGPDT,GMRGOUT D KVAR^VADPT K VA
- K ^TMP($J,"NURCEN")
- K N1,NBED,NI,NRMBD,NUREDB,NURSOUT,NURWARD
- CLEAN ; CLEAN UP FOR NEXT REPORT
- K %,%DT,%ZIS,ANS,D0,DA,DIC,DIPGM,DIQ,DR,GMRGLEN,GMRGPAR,GMRGPLN,GMRGXPRT,J,NAME,NDATA,NPWARD,NURQUEUE,NROOM,NURAGE,NURPR,NURSA,NURSADD,NURSALGR,NURSB,NURSC,NURSCHIL,NURSCLAS,NURSCPL,NURSDA,NURSDAT,NURSDIAG,NURSDOC,NURSE,NURSEND,NURSERR,NURCLEG
- K NURSG,NURSGCK,NURSGOCK,NURSH1,NURSH2,NURSH3,NURSH4,NURSH5,NURSH6,NURSH7,NURSHED,NURSI,NURSICK,NURSINCK,NURSIOSL
- K NURSISW,NURSISW1,NURSITHD,NURSJ,NURSK,NURSL,NURSLCNT,NURSLGT,NURSLIN,NURSLVD,NURSMAR,NURSMED,NURSO,NURSO1,NURSO2,NURSO4,NURSOT
- K NURSP,NURSP1,NURSP2,NURSP3,NURSPAG,NURSPAT,NURSPDT,NURSPNAM,NURSPOI,NURSPRB,NURSPROV,NURSRB,NURSREL,NURSRET,NURSRM,NURSRN,NURSRTK,NURSSP,NURSSS,NURSSSN,NURSSW1,NURST,NURSTAT,NURSTI,NURSTITL,NURUS,NURSWD,NURSX,POP,ZTSK,ZTDESC
- I $D(^TMP($J)) F X="NURSDATA","NURSOT","GMRGNAR","NURSGO","NURSIN","NURSDATE" K ^TMP($J,X)
- Q
- PRINT1 ; PRINT ONE PATIENT RECORD
- S NDATA=^TMP($J,"NURCEN",NBED,NBED(0),N1),DFN=$P(NDATA,"^")
- I "Pp"'[NUREDB S GMRGPDA=0 F X=0:0 Q:GMRGPDA>0 S X=$O(^GMR(124.3,"AA",DFN,+GMRGRT,X)) Q:X'>0 F GMRGPDA=0:0 S GMRGPDA=$O(^GMR(124.3,"AA",DFN,+GMRGRT,X,GMRGPDA)) Q:GMRGPDA'>0 I '+$G(^GMR(124.3,GMRGPDA,5)) Q
- PRINT2 ; PRINT ONE PATIENT RECORD GIVEN GMRGPDA.
- S GMRGPDA=+GMRGPDA,NURSPDT=$P($G(^GMR(124.3,GMRGPDA,0)),"^",3)
- D NOW^%DTC S GMRGPDT=$S(NURSPLN="C":%,1:NURSPDT)
- D DEM^VADPT,INP^VADPT
- S NURSPNAM=$E(VADM(1),1,20),NURSSSN=$S(VA("PID")'="":VA("PID"),1:" "),NURAGE=$S($P(VADM(4),"^")'="":$J($P(VADM(4),"^"),3),1:" ")
- S DIC="^DPT(",DR=".05;.08",DA=DFN,DIQ="NURSPAT(",DIQ(0)="I" D EN^DIQ1
- S NURSMAR=$P($G(^DIC(11,+$G(NURSPAT(2,DFN,.05,"I")),0)),"^",3),NURSMAR=$E(NURSMAR_" ")
- S NURSREL=$P($G(^DIC(13,+$G(NURSPAT(2,DFN,.08,"I")),0)),"^"),NURSREL=$E(NURSREL_" ",1,4)
- S NURSWD=$E($P(VAIN(4),"^",2),1,8)_$E(" ",$L($P(VAIN(4),"^",2))+1,8),NURSRB=$E(VAIN(5),1,10)_$E(" ",$L(VAIN(5))+1,10),NURSPROV=$E($P(VAIN(2),"^",2),1,20),NURSDIAG=VAIN(9)
- D LATER^NURCPPS3 D CLEAN
- Q
- EN2 ; Entry from GMRG Patient edit to print this Nursing Care Plan
- ; DFN, GMRGPDA, GMRGPDT and GMRGRT must be defined.
- Q:'$D(DFN)!'$D(GMRGPDA)!'$D(GMRGRT)!'$D(GMRGPDT) S NURSGMRG=1,NURSPLN="C" D DEM^VADPT,INP^VADPT,CONT^NURCPPS3,QUIT,KVAR^VADPT K NURSGMRG,NURSPLN,VA
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCPPS1 4449 printed Feb 18, 2025@23:47:10 Page 2
- NURCPPS1 ;HIRMFO/RM,RK-NURSING CARE PLAN REPORT USING GENERIC SORT ;8/29/96
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- EN1 ; ENTRY FROM OPTION NURCPE-CARE
- +1 if '$DATA(^DIC(213.9,1,"OFF"))
- QUIT
- if $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
- QUIT
- +2 SET GMRGRT=$ORDER(^GMRD(124.2,"AA","NURSC",2,"Nursing Care Plan",1,0))
- SET GMRGRT=GMRGRT_"^Nursing Care Plan"
- IF +GMRGRT'>0
- WRITE !,"The ""AA"" crossreference for file 124.2 needs to be re-crossreferenced."
- GOTO QUIT
- +3 SET (NURSGMRG,NURSOUT)=0
- SET GMRGOUT=0
- ASK ; GET PATIENT/ GROUP OF PATIENTS
- +1 SET NACT=0
- DO WARDPAT^NURCUT0
- if NURQUIT
- SET NURSOUT=1
- KILL DIC,NPWARD,NURQUIT
- if NURSOUT
- GOTO QUIT
- +2 IF "Pp"[NUREDB
- SET GMRGXPRT="1^0^0"
- DO EN1^GMRGRUT3
- if GMRGOUT
- SET NURSOUT=1
- KILL GMRGOUT,GMRGXPRT
- if NURSOUT
- GOTO QUIT
- if $GET(GMRGPDA)'>0
- GOTO ASK
- REASK ; SELECT CURRENT OR COMPLETE LISTING
- +1 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
- GOTO QUIT
- if NURSPLN=""
- GOTO ASK
- +2 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 only give the latest dates,",!?3,"or an A to get a complete listing with all of the dates"
- GOTO REASK
- +3 ;
- +4 WRITE !!,"This Report may be Queued to print on another device,",!,"freeing your terminal for other use.",!
- +5 SET GMRGPDT="N"
- FOR X="DFN","GMRGPDA","GMRGRT","NRMBD(","NURSPLN","NUREDB","NURWARD","NURSGMRG"
- SET ZTSAVE(X)=""
- +6 SET ZTDESC="Patient Care Plan Print"
- SET ZTRTN="REPORT^NURCPPS1"
- DO EN7^NURSUT0
- if POP!($DATA(ZTSK))
- GOTO QUIT
- +7 ;
- REPORT ; PRINT THESE REPORTS
- +1 if '$DATA(ZTQUEUED)
- DO WAIT^DICD
- USE IO
- +2 KILL ^TMP($JOB,"NURCEN")
- DO ^NURCAS2
- KILL NURWARD,NRMBD,DFN
- +3 IF '$DATA(^TMP($JOB,"NURCEN"))
- WRITE $CHAR(7),!,"NO PATIENTS WERE SELECTED."
- if '$DATA(ZTQUEUED)
- GOTO ASK
- GOTO QUIT
- PRINT ;PRINT ROUTINE
- +1 SET NURSOUT=0
- SET NBED=""
- FOR
- SET NBED=$ORDER(^TMP($JOB,"NURCEN",NBED))
- if NBED=""!NURSOUT
- QUIT
- Begin DoDot:1
- +2 SET NBED(0)=""
- +3 FOR
- SET NBED(0)=$ORDER(^TMP($JOB,"NURCEN",NBED,NBED(0)))
- if NBED(0)=""!NURSOUT
- QUIT
- Begin DoDot:2
- +4 SET N1=""
- +5 FOR
- SET N1=$ORDER(^TMP($JOB,"NURCEN",NBED,NBED(0),N1))
- if N1=""!NURSOUT
- QUIT
- DO PRINT1
- +6 QUIT
- End DoDot:2
- +7 QUIT
- End DoDot:1
- QUIT ; KILL LOCAL VARIABLES
- +1 DO ^%ZISC
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 IF 'NURSGMRG
- KILL NURSGMRG,NURSPLN,DFN,GMRGPDA,GMRGRT,GMRGPDT,GMRGOUT
- DO KVAR^VADPT
- KILL VA
- +3 KILL ^TMP($JOB,"NURCEN")
- +4 KILL N1,NBED,NI,NRMBD,NUREDB,NURSOUT,NURWARD
- CLEAN ; CLEAN UP FOR NEXT REPORT
- +1 KILL %,%DT,%ZIS,ANS,D0,DA,DIC,DIPGM,DIQ,DR,GMRGLEN,GMRGPAR,GMRGPLN,GMRGXPRT,J,NAME,NDATA,NPWARD,NURQUEUE,NROOM,NURAGE,NURPR,NURSA,NURSADD,NURSALGR,NURSB,NURSC,NURSCHIL,NURSCLAS,NURSCPL,NURSDA,NURSDAT,NURSDIAG,NURSDOC,NURSE,NURSEND,NURSERR,NURCL
- EG
- +2 KILL NURSG,NURSGCK,NURSGOCK,NURSH1,NURSH2,NURSH3,NURSH4,NURSH5,NURSH6,NURSH7,NURSHED,NURSI,NURSICK,NURSINCK,NURSIOSL
- +3 KILL NURSISW,NURSISW1,NURSITHD,NURSJ,NURSK,NURSL,NURSLCNT,NURSLGT,NURSLIN,NURSLVD,NURSMAR,NURSMED,NURSO,NURSO1,NURSO2,NURSO4,NURSOT
- +4 KILL NURSP,NURSP1,NURSP2,NURSP3,NURSPAG,NURSPAT,NURSPDT,NURSPNAM,NURSPOI,NURSPRB,NURSPROV,NURSRB,NURSREL,NURSRET,NURSRM,NURSRN,NURSRTK,NURSSP,NURSSS,NURSSSN,NURSSW1,NURST,NURSTAT,NURSTI,NURSTITL,NURUS,NURSWD,NURSX,POP,ZTSK,ZTDESC
- +5 IF $DATA(^TMP($JOB))
- FOR X="NURSDATA","NURSOT","GMRGNAR","NURSGO","NURSIN","NURSDATE"
- KILL ^TMP($JOB,X)
- +6 QUIT
- PRINT1 ; PRINT ONE PATIENT RECORD
- +1 SET NDATA=^TMP($JOB,"NURCEN",NBED,NBED(0),N1)
- SET DFN=$PIECE(NDATA,"^")
- +2 IF "Pp"'[NUREDB
- SET GMRGPDA=0
- FOR X=0:0
- if GMRGPDA>0
- QUIT
- SET X=$ORDER(^GMR(124.3,"AA",DFN,+GMRGRT,X))
- if X'>0
- QUIT
- FOR GMRGPDA=0:0
- SET GMRGPDA=$ORDER(^GMR(124.3,"AA",DFN,+GMRGRT,X,GMRGPDA))
- if GMRGPDA'>0
- QUIT
- IF '+$GET(^GMR(124.3,GMRGPDA,5))
- QUIT
- PRINT2 ; PRINT ONE PATIENT RECORD GIVEN GMRGPDA.
- +1 SET GMRGPDA=+GMRGPDA
- SET NURSPDT=$PIECE($GET(^GMR(124.3,GMRGPDA,0)),"^",3)
- +2 DO NOW^%DTC
- SET GMRGPDT=$SELECT(NURSPLN="C":%,1:NURSPDT)
- +3 DO DEM^VADPT
- DO INP^VADPT
- +4 SET NURSPNAM=$EXTRACT(VADM(1),1,20)
- SET NURSSSN=$SELECT(VA("PID")'="":VA("PID"),1:" ")
- SET NURAGE=$SELECT($PIECE(VADM(4),"^")'="":$JUSTIFY($PIECE(VADM(4),"^"),3),1:" ")
- +5 SET DIC="^DPT("
- SET DR=".05;.08"
- SET DA=DFN
- SET DIQ="NURSPAT("
- SET DIQ(0)="I"
- DO EN^DIQ1
- +6 SET NURSMAR=$PIECE($GET(^DIC(11,+$GET(NURSPAT(2,DFN,.05,"I")),0)),"^",3)
- SET NURSMAR=$EXTRACT(NURSMAR_" ")
- +7 SET NURSREL=$PIECE($GET(^DIC(13,+$GET(NURSPAT(2,DFN,.08,"I")),0)),"^")
- SET NURSREL=$EXTRACT(NURSREL_" ",1,4)
- +8 SET NURSWD=$EXTRACT($PIECE(VAIN(4),"^",2),1,8)_$EXTRACT(" ",$LENGTH($PIECE(VAIN(4),"^",2))+1,8)
- SET NURSRB=$EXTRACT(VAIN(5),1,10)_$EXTRACT(" ",$LENGTH(VAIN(5))+1,10)
- SET NURSPROV=$EXTRACT($PIECE(VAIN(2),"^",2),1,20)
- SET NURSDIAG=VAIN(9)
- +9 DO LATER^NURCPPS3
- DO CLEAN
- +10 QUIT
- EN2 ; Entry from GMRG Patient edit to print this Nursing Care Plan
- +1 ; DFN, GMRGPDA, GMRGPDT and GMRGRT must be defined.
- +2 if '$DATA(DFN)!'$DATA(GMRGPDA)!'$DATA(GMRGRT)!'$DATA(GMRGPDT)
- QUIT
- SET NURSGMRG=1
- SET NURSPLN="C"
- DO DEM^VADPT
- DO INP^VADPT
- DO CONT^NURCPPS3
- DO QUIT
- DO KVAR^VADPT
- KILL NURSGMRG,NURSPLN,VA
- +3 QUIT
