- NURARCRW ;HIRMFO/RM/FT/MD-VIEW PRINT PATIENT CLASSIFICATIONS BY WARD ;12/8/98
- ;;4.0;NURSING SERVICE;**12,20,22,26**;Apr 25, 1997
- Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
- S (NURQUIT,NURHOSP,NDATA,NURPAGE,NUROUT,NURQUEUE,NBRK,NURMDSW,NSW1,NURSW1)=0
- D EN9^NURSAGSP
- REENT ;
- W !!,?30,$S($G(NURCURSW):"Current",1:"Unit")_" Classification"
- W !!,?17,"Press return if total hospital report is desired"
- W !!,?17,"Enter unit number if this is a unit report: " R X:DTIME
- I (X="^")!('$T) S NUROUT=1 G QUIT
- I X="" S (NCOPY,NURHOSP)=1 G DEV
- S DIC("S")="I $S('$P($G(^NURSF(211.4,+Y,""I"")),U)'=""I"":1,1:0),$S($P($G(^(1)),U)=""A"":1,1:0)"
- S DIC="^NURSF(211.4,",DIC(0)="EQMZ" D ^DIC K DIC
- G:+Y'>0 REENT
- W ! D EN6^NURSUT0 G:NURQUIT QUIT
- S NURSW1=+Y,NURSW1("F")=Y(0,0)
- DEV I NURMDSW,NURHOSP W ! S DIC(0)="AEMQZ" D EN8^NURSAGSP I $G(NUROUT) G QUIT
- W ! S ZTRTN="START^NURARCRW" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
- START ;
- K ^TMP($J) S NTC=0 F X=1:1:5 S NTC(X)=0
- U IO I 'NURHOSP D SORT G QUIT:NUROUT
- I NURHOSP D
- . F NURSW1=0:0 S NURSW1=$O(^NURSF(214,"AF","A",NURSW1)) Q:NURSW1'>0 D SORT Q:NUROUT
- . Q
- I $E(IOST)="P" F NURI=1:1 Q:NURI>NCOPY D PRINT S (NSW1,NURPAGE)=0 W:$G(NCOPY)>1 @IOF
- I $E(IOST)="C" D PRINT
- QUIT D:'NUROUT CLOSE^NURSUT1,^NURAKILL
- Q
- PRINT ;
- S X=$O(^TMP($J,"")) I X="" S NDATA=1 S NURSWARD=$G(NURSW1("F")),NURFAC(3)=$S($G(NURFAC)=0:$G(NURFAC(1)),1:"") D HEADER W !!,"THERE IS NO DATA FOR "_$S($G(NURSW1("F"))'="":"THIS UNIT",1:"THE HOSPITAL") Q
- S NURFAC(3)="" F S NURFAC(3)=$O(^TMP($J,NURFAC(3))) Q:NURFAC(3)="" D NN Q:NUROUT
- Q
- NN S NURSWARD="" F S NURSWARD=$O(^TMP($J,NURFAC(3),NURSWARD)) Q:NURSWARD="" D:NSW1 HEADER Q:NUROUT D NO Q:NUROUT
- Q
- NO S NBEDS="" F S NBEDS=$O(^TMP($J,NURFAC(3),NURSWARD,NBEDS)) Q:NBEDS="" D:NSW1 BRK D NP Q:NUROUT W !
- Q
- NP S N1="" F S N1=$O(^TMP($J,NURFAC(3),NURSWARD,NBEDS,N1)) Q:N1="" D NQ Q:NUROUT
- Q
- NQ S NSUB="" F S NSUB=$O(^TMP($J,NURFAC(3),NURSWARD,NBEDS,N1,NSUB)) Q:NSUB="" D PRINTIT Q:NUROUT
- Q
- BRK W !,?8,"NURSING BED SECTION: ",NBEDS S NBD=(NBEDS="HEMODIALYSIS"!(NBEDS="DOMICILIARY")!(NBEDS="RECOVERY ROOM"))
- Q
- PRINTIT I 'NSW1!($Y>(IOSL-6)) D HEADER Q:NUROUT W:NURSW1 ! D BRK Q:NUROUT
- S DFN=$P(NSUB,"--",1),DA=$P(NSUB,"--",2) D DEM^VADPT
- S DATA=$S(DA'="":^NURSA(214.6,DA,0),1:""),SSN=VA("PID")
- W !!
- W:N1'=" BLANK" ?2,$E(N1,1,20)
- I NBD W ?24,"CLASSIFICATION NOT APPLICABLE"
- I 'NBD W ?24,$P(DATA,"^",3)
- I 'NBD F X=1:1:$L($P(DATA,"^",4)) W ?(31+((X-1)*2)),$E($P(DATA,"^",4),X)
- I 'NBD S Y=$P(DATA,"^",1) D:+Y D^DIQ W ?42,$P(Y,":",1,2),?62,$E($P(DATA,"^",7),1,18)
- W !,?2,SSN I $L($P(DATA,"^",7))>18,'NBD W ?62,$E($P(DATA,"^",7),19,36) I $L($P(DATA,"^",7))>36 W !,?62,$E($P(DATA,"^",7),37,50)
- Q
- I '$G(NDATA),'NURQUEUE,NSW1,$E(IOST)="C" D ENDPG^NURSUT1 Q:NUROUT
- S NURPAGE=NURPAGE+1
- W !,@IOF,?2,"UNIT PATIENT CLASSIFICATION REPORT",?51,"DATE:" S Y=DT D:+Y D^DIQ W ?57,Y,?71,"PAGE: ",NURPAGE
- W !!,?2,"PATIENT NAME/SSN",?24,"CLASS.",?32,"FACTORS",?43,"DATE",?62,"COMMENTS",!,$$REPEAT^XLFSTR("-",80)
- I NURHOSP,NURMDSW W !,?$$CNTR^NURSUT2(NURFAC(3)),$S($G(NURFAC(3))=" BLANK":"NO FACILITY",1:$G(NURFAC(3)))
- I $G(NURCURSW),$O(^TMP($J,""))'="",'NSW1,$D(NTC) D CAT
- W:NURSWARD'="" !!,?5,"UNIT: ",NURSWARD
- S NSW1=1
- Q
- SORT ;
- S:'NURHOSP!'(NURMDSW) NURFAC(2)=" BLANK"
- I NURMDSW,$G(NURFAC(2))'=" BLANK" S NURFAC(2)=$$EN12^NURSUT3($G(NURSW1))
- I NURMDSW,NURHOSP,$G(NURFAC)=0,$G(NURFAC(1))'=$G(NURFAC(2)) Q
- F DFN=0:0 S DFN=$O(^NURSF(214,"AF","A",NURSW1,DFN)) Q:DFN'>0 D
- . D EN6^NURSCUTL S NURSCLAS("CL")=1 D EN2^NURSCUTL,DEM^VADPT
- . I $S(NURSCLAS="":0,$D(^NURSA(214.6,"E",NURSW1,NURSCLAS)):0,1:1) S NURSCLAS=""
- . I $G(NURCURSW),+NURSCLAS'>0!'(+$G(^NURSA(214.6,+NURSCLAS,0))[DT) Q
- . ;I '$G(NURCURSW),+$G(^NURSA(214.6,+NURSCLAS,0))[DT Q
- . D
- . . I $E(IOST)="C",'$R(10) W "."
- . . S N1=$S(VADM(1)'="":VADM(1),1:" BLANK")
- . . S NCAT=$S(NURSCLAS'="":$P(^NURSA(214.6,NURSCLAS,0),U,3),1:"")
- . . S NS1=$S($D(^NURSF(214,DFN,0)):$P(^(0),"^",4),1:""),NS1(0)=$S(NURSCLAS="":"",$D(^NURSA(214.6,NURSCLAS,0)):$P(^(0),"^",9),1:"") S:NS1'=NS1(0)&(NS1'="") NURSCLAS=""
- . . I NS1'="",$D(^NURSF(213.3,NS1,0)),$P(^NURSF(213.3,NS1,0),"^",1)'="" S NBEDS=$S($P($G(^NURSF(213.3,NS1,0)),"^")'="":$P(^(0),"^"),1:" BLANK")
- . . S NPWARD=NURSW1 D EN6^NURSAUTL S NURSWARD=$S(NPWARD'="":NPWARD,1:" BLANK")
- . . S ^TMP($J,NURFAC(2),NURSWARD,NBEDS,N1,DFN_"--"_NURSCLAS)=""
- . . I NCAT'="" S NTC=NTC+1,NTC(NCAT)=NTC(NCAT)+1
- . . Q
- . Q
- Q
- CAT ; CATEGORY TOTAL DISPLAY
- W !!,?70,"PATIENTS",!,?29,"I II III IV V CLASSIFIED",!,?27,"---",?35,"---",?44,"---",?52,"---",?60,"---",?70,"----------"
- W !,"CATEGORY TOTALS:",?27,$J(NTC(1),3),?35,$J(NTC(2),3),?44,$J(NTC(3),3),?52,$J(NTC(4),3),?60,$J(NTC(5),3),?70,$J(NTC,10),!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURARCRW 4859 printed Jan 18, 2025@03:20:53 Page 2
- NURARCRW ;HIRMFO/RM/FT/MD-VIEW PRINT PATIENT CLASSIFICATIONS BY WARD ;12/8/98
- +1 ;;4.0;NURSING SERVICE;**12,20,22,26**;Apr 25, 1997
- +2 if '$DATA(^DIC(213.9,1,"OFF"))
- QUIT
- if $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
- QUIT
- +3 SET (NURQUIT,NURHOSP,NDATA,NURPAGE,NUROUT,NURQUEUE,NBRK,NURMDSW,NSW1,NURSW1)=0
- +4 DO EN9^NURSAGSP
- REENT ;
- +1 WRITE !!,?30,$SELECT($GET(NURCURSW):"Current",1:"Unit")_" Classification"
- +2 WRITE !!,?17,"Press return if total hospital report is desired"
- +3 WRITE !!,?17,"Enter unit number if this is a unit report: "
- READ X:DTIME
- +4 IF (X="^")!('$TEST)
- SET NUROUT=1
- GOTO QUIT
- +5 IF X=""
- SET (NCOPY,NURHOSP)=1
- GOTO DEV
- +6 SET DIC("S")="I $S('$P($G(^NURSF(211.4,+Y,""I"")),U)'=""I"":1,1:0),$S($P($G(^(1)),U)=""A"":1,1:0)"
- +7 SET DIC="^NURSF(211.4,"
- SET DIC(0)="EQMZ"
- DO ^DIC
- KILL DIC
- +8 if +Y'>0
- GOTO REENT
- +9 WRITE !
- DO EN6^NURSUT0
- if NURQUIT
- GOTO QUIT
- +10 SET NURSW1=+Y
- SET NURSW1("F")=Y(0,0)
- DEV IF NURMDSW
- IF NURHOSP
- WRITE !
- SET DIC(0)="AEMQZ"
- DO EN8^NURSAGSP
- IF $GET(NUROUT)
- GOTO QUIT
- +1 WRITE !
- SET ZTRTN="START^NURARCRW"
- DO EN7^NURSUT0
- if POP!($DATA(ZTSK))
- GOTO QUIT
- START ;
- +1 KILL ^TMP($JOB)
- SET NTC=0
- FOR X=1:1:5
- SET NTC(X)=0
- +2 USE IO
- IF 'NURHOSP
- DO SORT
- if NUROUT
- GOTO QUIT
- +3 IF NURHOSP
- Begin DoDot:1
- +4 FOR NURSW1=0:0
- SET NURSW1=$ORDER(^NURSF(214,"AF","A",NURSW1))
- if NURSW1'>0
- QUIT
- DO SORT
- if NUROUT
- QUIT
- +5 QUIT
- End DoDot:1
- +6 IF $EXTRACT(IOST)="P"
- FOR NURI=1:1
- if NURI>NCOPY
- QUIT
- DO PRINT
- SET (NSW1,NURPAGE)=0
- if $GET(NCOPY)>1
- WRITE @IOF
- +7 IF $EXTRACT(IOST)="C"
- DO PRINT
- QUIT if 'NUROUT
- DO CLOSE^NURSUT1
- DO ^NURAKILL
- +1 QUIT
- PRINT ;
- +1 SET X=$ORDER(^TMP($JOB,""))
- IF X=""
- SET NDATA=1
- SET NURSWARD=$GET(NURSW1("F"))
- SET NURFAC(3)=$SELECT($GET(NURFAC)=0:$GET(NURFAC(1)),1:"")
- DO HEADER
- WRITE !!,"THERE IS NO DATA FOR "_$SELECT($GET(NURSW1("F"))'="":"THIS UNIT",1:"THE HOSPITAL")
- QUIT
- +2 SET NURFAC(3)=""
- FOR
- SET NURFAC(3)=$ORDER(^TMP($JOB,NURFAC(3)))
- if NURFAC(3)=""
- QUIT
- DO NN
- if NUROUT
- QUIT
- +3 QUIT
- NN SET NURSWARD=""
- FOR
- SET NURSWARD=$ORDER(^TMP($JOB,NURFAC(3),NURSWARD))
- if NURSWARD=""
- QUIT
- if NSW1
- DO HEADER
- if NUROUT
- QUIT
- DO NO
- if NUROUT
- QUIT
- +1 QUIT
- NO SET NBEDS=""
- FOR
- SET NBEDS=$ORDER(^TMP($JOB,NURFAC(3),NURSWARD,NBEDS))
- if NBEDS=""
- QUIT
- if NSW1
- DO BRK
- DO NP
- if NUROUT
- QUIT
- WRITE !
- +1 QUIT
- NP SET N1=""
- FOR
- SET N1=$ORDER(^TMP($JOB,NURFAC(3),NURSWARD,NBEDS,N1))
- if N1=""
- QUIT
- DO NQ
- if NUROUT
- QUIT
- +1 QUIT
- NQ SET NSUB=""
- FOR
- SET NSUB=$ORDER(^TMP($JOB,NURFAC(3),NURSWARD,NBEDS,N1,NSUB))
- if NSUB=""
- QUIT
- DO PRINTIT
- if NUROUT
- QUIT
- +1 QUIT
- BRK WRITE !,?8,"NURSING BED SECTION: ",NBEDS
- SET NBD=(NBEDS="HEMODIALYSIS"!(NBEDS="DOMICILIARY")!(NBEDS="RECOVERY ROOM"))
- +1 QUIT
- PRINTIT IF 'NSW1!($Y>(IOSL-6))
- DO HEADER
- if NUROUT
- QUIT
- if NURSW1
- WRITE !
- DO BRK
- if NUROUT
- QUIT
- +1 SET DFN=$PIECE(NSUB,"--",1)
- SET DA=$PIECE(NSUB,"--",2)
- DO DEM^VADPT
- +2 SET DATA=$SELECT(DA'="":^NURSA(214.6,DA,0),1:"")
- SET SSN=VA("PID")
- +3 WRITE !!
- +4 if N1'=" BLANK"
- WRITE ?2,$EXTRACT(N1,1,20)
- +5 IF NBD
- WRITE ?24,"CLASSIFICATION NOT APPLICABLE"
- +6 IF 'NBD
- WRITE ?24,$PIECE(DATA,"^",3)
- +7 IF 'NBD
- FOR X=1:1:$LENGTH($PIECE(DATA,"^",4))
- WRITE ?(31+((X-1)*2)),$EXTRACT($PIECE(DATA,"^",4),X)
- +8 IF 'NBD
- SET Y=$PIECE(DATA,"^",1)
- if +Y
- DO D^DIQ
- WRITE ?42,$PIECE(Y,":",1,2),?62,$EXTRACT($PIECE(DATA,"^",7),1,18)
- +9 WRITE !,?2,SSN
- IF $LENGTH($PIECE(DATA,"^",7))>18
- IF 'NBD
- WRITE ?62,$EXTRACT($PIECE(DATA,"^",7),19,36)
- IF $LENGTH($PIECE(DATA,"^",7))>36
- WRITE !,?62,$EXTRACT($PIECE(DATA,"^",7),37,50)
- +10 QUIT
- +1 IF '$GET(NDATA)
- IF 'NURQUEUE
- IF NSW1
- IF $EXTRACT(IOST)="C"
- DO ENDPG^NURSUT1
- if NUROUT
- QUIT
- +2 SET NURPAGE=NURPAGE+1
- +3 WRITE !,@IOF,?2,"UNIT PATIENT CLASSIFICATION REPORT",?51,"DATE:"
- SET Y=DT
- if +Y
- DO D^DIQ
- WRITE ?57,Y,?71,"PAGE: ",NURPAGE
- +4 WRITE !!,?2,"PATIENT NAME/SSN",?24,"CLASS.",?32,"FACTORS",?43,"DATE",?62,"COMMENTS",!,$$REPEAT^XLFSTR("-",80)
- +5 IF NURHOSP
- IF NURMDSW
- WRITE !,?$$CNTR^NURSUT2(NURFAC(3)),$SELECT($GET(NURFAC(3))=" BLANK":"NO FACILITY",1:$GET(NURFAC(3)))
- +6 IF $GET(NURCURSW)
- IF $ORDER(^TMP($JOB,""))'=""
- IF 'NSW1
- IF $DATA(NTC)
- DO CAT
- +7 if NURSWARD'=""
- WRITE !!,?5,"UNIT: ",NURSWARD
- +8 SET NSW1=1
- +9 QUIT
- SORT ;
- +1 if 'NURHOSP!'(NURMDSW)
- SET NURFAC(2)=" BLANK"
- +2 IF NURMDSW
- IF $GET(NURFAC(2))'=" BLANK"
- SET NURFAC(2)=$$EN12^NURSUT3($GET(NURSW1))
- +3 IF NURMDSW
- IF NURHOSP
- IF $GET(NURFAC)=0
- IF $GET(NURFAC(1))'=$GET(NURFAC(2))
- QUIT
- +4 FOR DFN=0:0
- SET DFN=$ORDER(^NURSF(214,"AF","A",NURSW1,DFN))
- if DFN'>0
- QUIT
- Begin DoDot:1
- +5 DO EN6^NURSCUTL
- SET NURSCLAS("CL")=1
- DO EN2^NURSCUTL
- DO DEM^VADPT
- +6 IF $SELECT(NURSCLAS="":0,$DATA(^NURSA(214.6,"E",NURSW1,NURSCLAS)):0,1:1)
- SET NURSCLAS=""
- +7 IF $GET(NURCURSW)
- IF +NURSCLAS'>0!'(+$GET(^NURSA(214.6,+NURSCLAS,0))[DT)
- QUIT
- +8 ;I '$G(NURCURSW),+$G(^NURSA(214.6,+NURSCLAS,0))[DT Q
- +9 Begin DoDot:2
- +10 IF $EXTRACT(IOST)="C"
- IF '$RANDOM(10)
- WRITE "."
- +11 SET N1=$SELECT(VADM(1)'="":VADM(1),1:" BLANK")
- +12 SET NCAT=$SELECT(NURSCLAS'="":$PIECE(^NURSA(214.6,NURSCLAS,0),U,3),1:"")
- +13 SET NS1=$SELECT($DATA(^NURSF(214,DFN,0)):$PIECE(^(0),"^",4),1:"")
- SET NS1(0)=$SELECT(NURSCLAS="":"",$DATA(^NURSA(214.6,NURSCLAS,0)):$PIECE(^(0),"^",9),1:"")
- if NS1'=NS1(0)&(NS1'="")
- SET NURSCLAS=""
- +14 IF NS1'=""
- IF $DATA(^NURSF(213.3,NS1,0))
- IF $PIECE(^NURSF(213.3,NS1,0),"^",1)'=""
- SET NBEDS=$SELECT($PIECE($GET(^NURSF(213.3,NS1,0)),"^")'="":$PIECE(^(0),"^"),1:" BLANK")
- +15 SET NPWARD=NURSW1
- DO EN6^NURSAUTL
- SET NURSWARD=$SELECT(NPWARD'="":NPWARD,1:" BLANK")
- +16 SET ^TMP($JOB,NURFAC(2),NURSWARD,NBEDS,N1,DFN_"--"_NURSCLAS)=""
- +17 IF NCAT'=""
- SET NTC=NTC+1
- SET NTC(NCAT)=NTC(NCAT)+1
- +18 QUIT
- End DoDot:2
- +19 QUIT
- End DoDot:1
- +20 QUIT
- CAT ; CATEGORY TOTAL DISPLAY
- +1 WRITE !!,?70,"PATIENTS",!,?29,"I II III IV V CLASSIFIED",!,?27,"---",?35,"---",?44,"---",?52,"---",?60,"---",?70,"----------"
- +2 WRITE !,"CATEGORY TOTALS:",?27,$JUSTIFY(NTC(1),3),?35,$JUSTIFY(NTC(2),3),?44,$JUSTIFY(NTC(3),3),?52,$JUSTIFY(NTC(4),3),?60,$JUSTIFY(NTC(5),3),?70,$JUSTIFY(NTC,10),!
- +3 QUIT