- 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 Apr 23, 2025@18:35:26 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
