| 1 | NURCROP0 ;HIRMFO/RM,RTK-CARE PLAN RANK ORDER PRINT ;8/29/96
|
|---|
| 2 | ;;4.0;NURSING SERVICE;;Apr 25, 1997
|
|---|
| 3 | EN1 ; ENTRY FROM OPTION TO PRINT RANK ORDER LISTING OF CARE PLAN
|
|---|
| 4 | ;
|
|---|
| 5 | ; Select Date/Time range for report
|
|---|
| 6 | S %DT("A")="Start with Date (Time Optional): ",%DT="AET",%DT(0)="-NOW" D ^%DT I +Y'>0 G EXIT
|
|---|
| 7 | S NURCBGDT=+Y
|
|---|
| 8 | 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")
|
|---|
| 9 | E G EXIT
|
|---|
| 10 | ;
|
|---|
| 11 | ; Select Ward(s) for report :Use Nursing utility
|
|---|
| 12 | W ! I $$MDIC^NURSAGS0'>0 G EXIT
|
|---|
| 13 | 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
|
|---|
| 14 | .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)=""
|
|---|
| 15 | ;
|
|---|
| 16 | ; Select the Ward/Group Report ID for the header
|
|---|
| 17 | K DIRUT S NURCLID=$$RPRTID^NURCROP2 G:$D(DIRUT) EXIT
|
|---|
| 18 | ;
|
|---|
| 19 | ; Select whether report is for Admitting location or all locations
|
|---|
| 20 | W ! S NURCSORT=$$SORTYP^NURCROP2 G EXIT:NURCSORT'>0
|
|---|
| 21 | DEV ; Ask device and allow to queue
|
|---|
| 22 | ; If QUEUE then call ^%ZTLOAD and exit
|
|---|
| 23 | W ! S %ZIS="Q" D ^%ZIS I POP K IO("Q") G EXIT
|
|---|
| 24 | 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
|
|---|
| 25 | 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")=""
|
|---|
| 26 | I D ^%ZTLOAD K ZTSK G EXIT
|
|---|
| 27 | ;
|
|---|
| 28 | PRINT ; ENTRY FROM TASK TO PRINT RANK ORDER PRINT IF QUEUED TO DEVICE
|
|---|
| 29 | ;
|
|---|
| 30 | ; Set up required variables for sort.
|
|---|
| 31 | ; Calculate patient census over date/time range.
|
|---|
| 32 | K ^TMP($J)
|
|---|
| 33 | 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))
|
|---|
| 34 | 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
|
|---|
| 35 | ;
|
|---|
| 36 | ; Loop through ^TMP($J,"NURCEN",DFN) and get DFN to process
|
|---|
| 37 | ; Loop through ^GMR(124.3,"AA",DFN,DATE) over date time range
|
|---|
| 38 | ; BEGIN
|
|---|
| 39 | 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
|
|---|
| 40 | .; Get a care plan
|
|---|
| 41 | .S NURCPDA=$O(^GMR(124.3,"AA",DFN,NURCNCP,NURCDATE,0)) Q:NURCPDA'>0
|
|---|
| 42 | .; Loop through all entries in SELECTION multiple
|
|---|
| 43 | .; If ACTIVE(PROBLEM(entry)) THEN
|
|---|
| 44 | .; BEGIN
|
|---|
| 45 | .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
|
|---|
| 46 | ..; Find frame with CLASSIFICATION=NURSING INTERVENTION that
|
|---|
| 47 | ..; is under this problem.
|
|---|
| 48 | ..S NURCITRM=$$GETTRM^NURCROP1(NURCPTRM,NURCINT)
|
|---|
| 49 | ..; Get list of all frames/terms under NURSING INTERVENTION
|
|---|
| 50 | ..; frame with CLASSIFICATION=ORDERABLE in NURSLIST.
|
|---|
| 51 | ..; If NURSLIST is not empty then Loop through list
|
|---|
| 52 | ..; BEGIN
|
|---|
| 53 | ..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
|
|---|
| 54 | ...; Set up sort arrays for the orderables
|
|---|
| 55 | ...K ^TMP($J,"NURSIR",NURCPTRM,9999999-$G(^TMP($J,"NURSORD",NURCPTRM,NURCOTRM)),NURCOTRM)
|
|---|
| 56 | ...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)=""
|
|---|
| 57 | ..; END
|
|---|
| 58 | ..; Set up the sort arrays for the problems
|
|---|
| 59 | ..K ^TMP($J,"NURSPR",9999999-$G(^TMP($J,"NURSPROB",NURCPTRM)),NURCPTRM)
|
|---|
| 60 | ..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)=""
|
|---|
| 61 | .; END
|
|---|
| 62 | ; END
|
|---|
| 63 | ;
|
|---|
| 64 | ; Use IO
|
|---|
| 65 | ; Print Header
|
|---|
| 66 | U IO S NURCPAGE=$$HEADER^NURCROP1(0)
|
|---|
| 67 | I '$D(^TMP($J,"NURSPR")) W !!,"There is no data for this report." G EXIT
|
|---|
| 68 | ;
|
|---|
| 69 | ; Print the report
|
|---|
| 70 | ;
|
|---|
| 71 | D PRINT^NURCROP2
|
|---|
| 72 | EXIT ;
|
|---|
| 73 | ; Clean up variables
|
|---|
| 74 | I $D(ZTSK)#2 D KILL^%ZTLOAD
|
|---|
| 75 | K ^TMP($J) D KVAR^VADPT,CLOSE^NURSUT1,^NURCKILL
|
|---|
| 76 | Q
|
|---|
