NURCROP0 ;HIRMFO/RM,RTK-CARE PLAN RANK ORDER PRINT ;8/29/96
;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ; ENTRY FROM OPTION TO PRINT RANK ORDER LISTING OF CARE PLAN
;
; Select Date/Time range for report
S %DT("A")="Start with Date (Time Optional): ",%DT="AET",%DT(0)="-NOW" D ^%DT I +Y'>0 G EXIT
S NURCBGDT=+Y
ENDT S %DT("A")="Go to Date (Time Optional): ",%DT="AET",%DT(0)=NURCBGDT D ^%DT I +Y>0 S X=+Y,%DT="T",%DT(0)="-NOW" D ^%DT W:+Y'>0 $C(7)," ??" G:+Y'>0 ENDT I +Y>0 S NURCENDT=+Y_$S(Y[".":"",1:".24")
E G EXIT
;
; Select Ward(s) for report :Use Nursing utility
W ! I $$MDIC^NURSAGS0'>0 G EXIT
S X="" F S X=$O(NURSNLOC(X)) Q:X="" F Y=0:0 S Y=$O(NURSNLOC(X,Y)) Q:Y'>0 F NURC=0:0 S NURC=$O(^NURSF(211.4,Y,3,NURC)) Q:NURC'>0 D
.S NURSMAS=+$G(^NURSF(211.4,Y,3,NURC,0)) I NURSMAS>0 S NURSMAS(0)=$P($G(^DIC(42,NURSMAS,0)),"^") I $L(NURSMAS(0)) S NURSMAS(NURSMAS(0),NURSMAS)=""
;
; Select the Ward/Group Report ID for the header
K DIRUT S NURCLID=$$RPRTID^NURCROP2 G:$D(DIRUT) EXIT
;
; Select whether report is for Admitting location or all locations
W ! S NURCSORT=$$SORTYP^NURCROP2 G EXIT:NURCSORT'>0
DEV ; Ask device and allow to queue
; If QUEUE then call ^%ZTLOAD and exit
W ! S %ZIS="Q" D ^%ZIS I POP K IO("Q") G EXIT
I $E(IOST)="P",'$D(IO("Q")),'$D(IO("S")) D ^%ZISC S XQH="NURS-PRINTER QUEUE" W $C(7) D EN^XQH K XQH G DEV
I $D(IO("Q")) K IO("Q") S ZTIO=ION,ZTRTN="PRINT^NURCROP0",ZTDESC="Nursing Care Plan Statistics - Rank Order Print",ZTSAVE("NURSMAS*")="",ZTSAVE("NURCBGDT")="",ZTSAVE("NURCENDT")="",ZTSAVE("NURCSORT")="",ZTSAVE("NURCLID")=""
I D ^%ZTLOAD K ZTSK G EXIT
;
PRINT ; ENTRY FROM TASK TO PRINT RANK ORDER PRINT IF QUEUED TO DEVICE
;
; Set up required variables for sort.
; Calculate patient census over date/time range.
K ^TMP($J)
D NOW^%DTC S NURCNOW=%,NURCNCP=$O(^GMRD(124.2,"AA","NURSC",2,"Nursing Care Plan",1,0)),NURCINT=$O(^GMRD(124.25,"AA","NURSC","NURSING INTERVENTION",0)),NURCORD=$O(^GMRD(124.25,"AA","NURSC","ORDERABLE",0))
I '$$CENSUS^NURSACE0(NURCBGDT,NURCENDT,NURCNOW,NURCSORT)!'NURCNCP!'NURCINT!'NURCORD U IO S NURCPAGE=$$HEADER^NURCROP1(0) W !!,"There is no data for this report." S NURCPAGE=$$HEADER^NURCROP1(-1) G EXIT
;
; Loop through ^TMP($J,"NURCEN",DFN) and get DFN to process
; Loop through ^GMR(124.3,"AA",DFN,DATE) over date time range
; BEGIN
F DFN=0:0 S DFN=$O(^TMP($J,"NURCEN",DFN)) Q:DFN'>0 D DEM^VADPT S NURCBS5=$E(VADM(1))_$P($P(VADM(2),"^",2),"-",3) F NURCDATE=(9999999-NURCENDT):0 S NURCDATE=$O(^GMR(124.3,"AA",DFN,NURCNCP,NURCDATE)) Q:NURCDATE'>0 D
.; Get a care plan
.S NURCPDA=$O(^GMR(124.3,"AA",DFN,NURCNCP,NURCDATE,0)) Q:NURCPDA'>0
.; Loop through all entries in SELECTION multiple
.; If ACTIVE(PROBLEM(entry)) THEN
.; BEGIN
.F NURCPDA1=0:0 S NURCPDA1=$O(^GMR(124.3,NURCPDA,1,NURCPDA1)) Q:NURCPDA1'>0 S NURCPTRM=+$G(^GMR(124.3,NURCPDA,1,NURCPDA1,0)) I $$ACTIVE^NURCROP1(NURCPTRM,NURCPDA,NURCBGDT,NURCENDT) D
..; Find frame with CLASSIFICATION=NURSING INTERVENTION that
..; is under this problem.
..S NURCITRM=$$GETTRM^NURCROP1(NURCPTRM,NURCINT)
..; Get list of all frames/terms under NURSING INTERVENTION
..; frame with CLASSIFICATION=ORDERABLE in NURSLIST.
..; If NURSLIST is not empty then Loop through list
..; BEGIN
..I $$GETLST^NURCROP1(NURCITRM,NURCORD) F NURCOTRM=0:0 S NURCOTRM=$O(NURSLIST(NURCOTRM)) Q:NURCOTRM'>0 I $D(^GMR(124.3,NURCPDA,1,"B",NURCOTRM)) D
...; Set up sort arrays for the orderables
...K ^TMP($J,"NURSIR",NURCPTRM,9999999-$G(^TMP($J,"NURSORD",NURCPTRM,NURCOTRM)),NURCOTRM)
...S ^TMP($J,"NURSORD",NURCPTRM,NURCOTRM)=$G(^TMP($J,"NURSORD",NURCPTRM,NURCOTRM))+1,^TMP($J,"NURSIR",NURCPTRM,9999999-^TMP($J,"NURSORD",NURCPTRM,NURCOTRM),NURCOTRM)="",^TMP($J,"NURSORD",NURCPTRM,NURCOTRM,NURCBS5)=""
..; END
..; Set up the sort arrays for the problems
..K ^TMP($J,"NURSPR",9999999-$G(^TMP($J,"NURSPROB",NURCPTRM)),NURCPTRM)
..S ^TMP($J,"NURSPROB",NURCPTRM)=$G(^TMP($J,"NURSPROB",NURCPTRM))+1,^TMP($J,"NURSPR",9999999-^TMP($J,"NURSPROB",NURCPTRM),NURCPTRM)="",^TMP($J,"NURSPROB",NURCPTRM,NURCBS5)=""
.; END
; END
;
; Use IO
; Print Header
U IO S NURCPAGE=$$HEADER^NURCROP1(0)
I '$D(^TMP($J,"NURSPR")) W !!,"There is no data for this report." G EXIT
;
; Print the report
;
D PRINT^NURCROP2
EXIT ;
; Clean up variables
I $D(ZTSK)#2 D KILL^%ZTLOAD
K ^TMP($J) D KVAR^VADPT,CLOSE^NURSUT1,^NURCKILL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCROP0 4576 printed Dec 13, 2024@02:20:54 Page 2
NURCROP0 ;HIRMFO/RM,RTK-CARE PLAN RANK ORDER PRINT ;8/29/96
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ; ENTRY FROM OPTION TO PRINT RANK ORDER LISTING OF CARE PLAN
+1 ;
+2 ; Select Date/Time range for report
+3 SET %DT("A")="Start with Date (Time Optional): "
SET %DT="AET"
SET %DT(0)="-NOW"
DO ^%DT
IF +Y'>0
GOTO EXIT
+4 SET NURCBGDT=+Y
ENDT SET %DT("A")="Go to Date (Time Optional): "
SET %DT="AET"
SET %DT(0)=NURCBGDT
DO ^%DT
IF +Y>0
SET X=+Y
SET %DT="T"
SET %DT(0)="-NOW"
DO ^%DT
if +Y'>0
WRITE $CHAR(7)," ??"
if +Y'>0
GOTO ENDT
IF +Y>0
SET NURCENDT=+Y_$SELECT(Y[".":"",1:".24")
+1 IF '$TEST
GOTO EXIT
+2 ;
+3 ; Select Ward(s) for report :Use Nursing utility
+4 WRITE !
IF $$MDIC^NURSAGS0'>0
GOTO EXIT
+5 SET X=""
FOR
SET X=$ORDER(NURSNLOC(X))
if X=""
QUIT
FOR Y=0:0
SET Y=$ORDER(NURSNLOC(X,Y))
if Y'>0
QUIT
FOR NURC=0:0
SET NURC=$ORDER(^NURSF(211.4,Y,3,NURC))
if NURC'>0
QUIT
Begin DoDot:1
+6 SET NURSMAS=+$GET(^NURSF(211.4,Y,3,NURC,0))
IF NURSMAS>0
SET NURSMAS(0)=$PIECE($GET(^DIC(42,NURSMAS,0)),"^")
IF $LENGTH(NURSMAS(0))
SET NURSMAS(NURSMAS(0),NURSMAS)=""
End DoDot:1
+7 ;
+8 ; Select the Ward/Group Report ID for the header
+9 KILL DIRUT
SET NURCLID=$$RPRTID^NURCROP2
if $DATA(DIRUT)
GOTO EXIT
+10 ;
+11 ; Select whether report is for Admitting location or all locations
+12 WRITE !
SET NURCSORT=$$SORTYP^NURCROP2
if NURCSORT'>0
GOTO EXIT
DEV ; Ask device and allow to queue
+1 ; If QUEUE then call ^%ZTLOAD and exit
+2 WRITE !
SET %ZIS="Q"
DO ^%ZIS
IF POP
KILL IO("Q")
GOTO EXIT
+3 IF $EXTRACT(IOST)="P"
IF '$DATA(IO("Q"))
IF '$DATA(IO("S"))
DO ^%ZISC
SET XQH="NURS-PRINTER QUEUE"
WRITE $CHAR(7)
DO EN^XQH
KILL XQH
GOTO DEV
+4 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTIO=ION
SET ZTRTN="PRINT^NURCROP0"
SET ZTDESC="Nursing Care Plan Statistics - Rank Order Print"
SET ZTSAVE("NURSMAS*")=""
SET ZTSAVE("NURCBGDT")=""
SET ZTSAVE("NURCENDT")=""
SET ZTSAVE("NURCSORT")=""
SET ZTSAVE("NURCLID")=""
+5 IF $TEST
DO ^%ZTLOAD
KILL ZTSK
GOTO EXIT
+6 ;
PRINT ; ENTRY FROM TASK TO PRINT RANK ORDER PRINT IF QUEUED TO DEVICE
+1 ;
+2 ; Set up required variables for sort.
+3 ; Calculate patient census over date/time range.
+4 KILL ^TMP($JOB)
+5 DO NOW^%DTC
SET NURCNOW=%
SET NURCNCP=$ORDER(^GMRD(124.2,"AA","NURSC",2,"Nursing Care Plan",1,0))
SET NURCINT=$ORDER(^GMRD(124.25,"AA","NURSC","NURSING INTERVENTION",0))
SET NURCORD=$ORDER(^GMRD(124.25,"AA","NURSC","ORDERABLE",0))
+6 IF '$$CENSUS^NURSACE0(NURCBGDT,NURCENDT,NURCNOW,NURCSORT)!'NURCNCP!'NURCINT!'NURCORD
USE IO
SET NURCPAGE=$$HEADER^NURCROP1(0)
WRITE !!,"There is no data for this report."
SET NURCPAGE=$$HEADER^NURCROP1(-1)
GOTO EXIT
+7 ;
+8 ; Loop through ^TMP($J,"NURCEN",DFN) and get DFN to process
+9 ; Loop through ^GMR(124.3,"AA",DFN,DATE) over date time range
+10 ; BEGIN
+11 FOR DFN=0:0
SET DFN=$ORDER(^TMP($JOB,"NURCEN",DFN))
if DFN'>0
QUIT
DO DEM^VADPT
SET NURCBS5=$EXTRACT(VADM(1))_$PIECE($PIECE(VADM(2),"^",2),"-",3)
FOR NURCDATE=(9999999-NURCENDT):0
SET NURCDATE=$ORDER(^GMR(124.3,"AA",DFN,NURCNCP,NURCDATE))
if NURCDATE'>0
QUIT
Begin DoDot:1
+12 ; Get a care plan
+13 SET NURCPDA=$ORDER(^GMR(124.3,"AA",DFN,NURCNCP,NURCDATE,0))
if NURCPDA'>0
QUIT
+14 ; Loop through all entries in SELECTION multiple
+15 ; If ACTIVE(PROBLEM(entry)) THEN
+16 ; BEGIN
+17 FOR NURCPDA1=0:0
SET NURCPDA1=$ORDER(^GMR(124.3,NURCPDA,1,NURCPDA1))
if NURCPDA1'>0
QUIT
SET NURCPTRM=+$GET(^GMR(124.3,NURCPDA,1,NURCPDA1,0))
IF $$ACTIVE^NURCROP1(NURCPTRM,NURCPDA,NURCBGDT,NURCENDT)
Begin DoDot:2
+18 ; Find frame with CLASSIFICATION=NURSING INTERVENTION that
+19 ; is under this problem.
+20 SET NURCITRM=$$GETTRM^NURCROP1(NURCPTRM,NURCINT)
+21 ; Get list of all frames/terms under NURSING INTERVENTION
+22 ; frame with CLASSIFICATION=ORDERABLE in NURSLIST.
+23 ; If NURSLIST is not empty then Loop through list
+24 ; BEGIN
+25 IF $$GETLST^NURCROP1(NURCITRM,NURCORD)
FOR NURCOTRM=0:0
SET NURCOTRM=$ORDER(NURSLIST(NURCOTRM))
if NURCOTRM'>0
QUIT
IF $DATA(^GMR(124.3,NURCPDA,1,"B",NURCOTRM))
Begin DoDot:3
+26 ; Set up sort arrays for the orderables
+27 KILL ^TMP($JOB,"NURSIR",NURCPTRM,9999999-$GET(^TMP($JOB,"NURSORD",NURCPTRM,NURCOTRM)),NURCOTRM)
+28 SET ^TMP($JOB,"NURSORD",NURCPTRM,NURCOTRM)=$GET(^TMP($JOB,"NURSORD",NURCPTRM,NURCOTRM))+1
SET ^TMP($JOB,"NURSIR",NURCPTRM,9999999-^TMP($JOB,"NURSORD",NURCPTRM,NURCOTRM),NURCOTRM)=""
SET ^TMP($JOB,"NURSORD",NURCPTRM,NURCOTRM,NURCBS5)=""
End DoDot:3
+29 ; END
+30 ; Set up the sort arrays for the problems
+31 KILL ^TMP($JOB,"NURSPR",9999999-$GET(^TMP($JOB,"NURSPROB",NURCPTRM)),NURCPTRM)
+32 SET ^TMP($JOB,"NURSPROB",NURCPTRM)=$GET(^TMP($JOB,"NURSPROB",NURCPTRM))+1
SET ^TMP($JOB,"NURSPR",9999999-^TMP($JOB,"NURSPROB",NURCPTRM),NURCPTRM)=""
SET ^TMP($JOB,"NURSPROB",NURCPTRM,NURCBS5)=""
End DoDot:2
+33 ; END
End DoDot:1
+34 ; END
+35 ;
+36 ; Use IO
+37 ; Print Header
+38 USE IO
SET NURCPAGE=$$HEADER^NURCROP1(0)
+39 IF '$DATA(^TMP($JOB,"NURSPR"))
WRITE !!,"There is no data for this report."
GOTO EXIT
+40 ;
+41 ; Print the report
+42 ;
+43 DO PRINT^NURCROP2
EXIT ;
+1 ; Clean up variables
+2 IF $DATA(ZTSK)#2
DO KILL^%ZTLOAD
+3 KILL ^TMP($JOB)
DO KVAR^VADPT
DO CLOSE^NURSUT1
DO ^NURCKILL
+4 QUIT
