- NURARNCT ;HIRMFO/RM/MD,FT-REPORT SHOWING NOT CLASSIFIED PATIENTS FOR HOSP. 2/2/96 ;8/9/96 11:35
- ;;4.0;NURSING SERVICE;**20**;Apr 25, 1997
- Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
- S (NURQUIT,NURQUEUE,NURMDSW,NURSW1)=0
- D EN9^NURSAGSP I NURMDSW W ! S DIC(0)="AEMQZ" D EN8^NURSAGSP I $G(NUROUT) G QUIT
- W ! S ZTRTN="Q1^NURARNCT" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
- Q1 ;
- D NOW^%DTC S Y=% X ^DD("DD") S NDATE=$P(Y,":",1,2) S (NURSW1,NURPAGE)=0 K ^TMP($J) D SORT
- I $O(^TMP($J,""))="" S NL1="",NURFAC(3)=$S($G(NURFAC)=0:NURFAC(1),1:"") D HEADER W !,"THERE IS NO DATA FOR THIS REPORT" G QUIT
- U IO S NBR=0 Q:NURQUIT S NBR=1 D WRTE
- QUIT ; KILL LOCAL VARIABLES
- K ^TMP($J) D CLOSE^NURSUT1,^NURAKILL
- Q
- SORT F NL1=0:0 S NL1=$O(^NURSF(214,"AF","A",NL1)) Q:NL1'>0 F DA=0:0 S DA=$O(^NURSF(214,"AF","A",NL1,DA)) Q:DA'>0 S NDAT=$S($D(^NURSF(214,DA,0)):^(0),1:""),DFN=$P(NDAT,"^") D:DFN'="" SORT1
- Q
- SORT1 ;
- S:'NURMDSW NURFAC(2)=" BLANK"
- I NURMDSW S NURFAC(2)=$$EN12^NURSUT3($G(NL1))
- I NURMDSW,'$G(NURFAC),$G(NURFAC(1))'=$G(NURFAC(2)) Q
- D 1^VADPT W:$E(IOST)="C" "." S NCLAS=$O(^NURSA(214.6,"AA",DFN,"")) I NCLAS="" S NCLAS=0 G A
- D EN6^NURSCUTL S NURSCLAS("CL")=1 D EN2^NURSCUTL S NCLAS=$S(NURSCLAS="":"",$D(^NURSA(214.6,NURSCLAS,0)):^(0),1:"")
- A I $P($P(NCLAS,"^"),".")<DT S NBED=$S($P(NDAT,"^",4)="":"",$D(^NURSF(213.3,$P(NDAT,"^",4),0)):$P(^(0),"^"),1:"") I NBED'="HEMODIALYSIS",NBED'="DOMICILIARY",NBED'="RECOVERY ROOM" D
- . S NRMBD=$S(VAIN(5)'="":VAIN(5),1:" BLANK"),NNM=$S(VADM(1)'="":VADM(1),1:" BLANK"),SSN=$S(+$G(VADM(2))'="":$P(VADM(2),U,2),1:" BLANK")
- . S NPWARD=NL1 D EN6^NURSAUTL S NPWARD=$S(NPWARD'="":NPWARD,1:" BLANK") S ^TMP($J,NURFAC(2),NPWARD,NRMBD,NNM,+$P(NCLAS,"^")_"--"_DFN,SSN)=""
- . Q
- Q
- WRTE ;
- S NURFAC(3)="" F S NURFAC(3)=$O(^TMP($J,NURFAC(3))) Q:NURFAC(3)=""!(NURQUIT) D:NURSW1 HEADER Q:NURQUIT D AA Q:NURQUIT
- Q
- AA S NL1="" F S NL1=$O(^TMP($J,NURFAC(3),NL1)) Q:NL1=""!(NURQUIT) W:NURSW1 !!,?5,"WARD: ",NL1 S NRMBD="" F S NRMBD=$O(^TMP($J,NURFAC(3),NL1,NRMBD)) Q:NRMBD=""!NURQUIT D Q:NURQUIT
- . S NNM="" F S NNM=$O(^TMP($J,NURFAC(3),NL1,NRMBD,NNM)) Q:NNM=""!NURQUIT S NSUB="" F S NSUB=$O(^TMP($J,NURFAC(3),NL1,NRMBD,NNM,NSUB)) Q:NSUB=""!NURQUIT S SSN="" F S SSN=$O(^(NSUB,SSN)) Q:SSN=""!NURQUIT D Q:NURQUIT
- . . I 'NURSW1!($Y>(IOSL-4)) D HEADER Q:NURQUIT
- . . S NBR=1,Y=$P(NSUB,"--",1) D:+Y D^DIQ S NCLAS=$S(Y'=0:Y,1:"NOT CLASSIFIED YET")
- . . S DFN=$P(NSUB,"--",2) D ^NURSAPCH
- . . W !!,$S(NRMBD'=" BLANK":NRMBD,1:""),?18,$S(NNM'=" BLANK":$E(NNM,1,20),1:""),?48,NCLAS,?71,NURSX,!,?18,SSN
- . . Q
- . Q
- Q
- I NURSW1,$E(IOST)="C",'NURQUEUE D ENDPG^NURSUT1 S:NUROUT NURQUIT=+NUROUT Q:NURQUIT
- S NURSW1=1,NURPAGE=NURPAGE+1
- W:$E(IOST)="C"!(NURPAGE>1) @IOF
- W !,NDATE,?18,"CURRENT UNCLASSIFIED PATIENT REPORT FOR THE HOSPITAL",?72,"PAGE: "_NURPAGE
- W !!,"ROOM-BED",?18,"PATIENT",?50,"LAST CLASSIFIED",?70,"ABSENCE",!,?18,"SSN",!
- F X=1:1:80 W "-"
- I NURMDSW W !,?35,$S($G(NURFAC(3))=" BLANK":"NO FACLILTY",1:$G(NURFAC(3)))
- W:NL1'="" !!,?5,"WARD: ",NL1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURARNCT 3090 printed Mar 13, 2025@21:24:52 Page 2
- NURARNCT ;HIRMFO/RM/MD,FT-REPORT SHOWING NOT CLASSIFIED PATIENTS FOR HOSP. 2/2/96 ;8/9/96 11:35
- +1 ;;4.0;NURSING SERVICE;**20**;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,NURQUEUE,NURMDSW,NURSW1)=0
- +4 DO EN9^NURSAGSP
- IF NURMDSW
- WRITE !
- SET DIC(0)="AEMQZ"
- DO EN8^NURSAGSP
- IF $GET(NUROUT)
- GOTO QUIT
- +5 WRITE !
- SET ZTRTN="Q1^NURARNCT"
- DO EN7^NURSUT0
- if POP!($DATA(ZTSK))
- GOTO QUIT
- Q1 ;
- +1 DO NOW^%DTC
- SET Y=%
- XECUTE ^DD("DD")
- SET NDATE=$PIECE(Y,":",1,2)
- SET (NURSW1,NURPAGE)=0
- KILL ^TMP($JOB)
- DO SORT
- +2 IF $ORDER(^TMP($JOB,""))=""
- SET NL1=""
- SET NURFAC(3)=$SELECT($GET(NURFAC)=0:NURFAC(1),1:"")
- DO HEADER
- WRITE !,"THERE IS NO DATA FOR THIS REPORT"
- GOTO QUIT
- +3 USE IO
- SET NBR=0
- if NURQUIT
- QUIT
- SET NBR=1
- DO WRTE
- QUIT ; KILL LOCAL VARIABLES
- +1 KILL ^TMP($JOB)
- DO CLOSE^NURSUT1
- DO ^NURAKILL
- +2 QUIT
- SORT FOR NL1=0:0
- SET NL1=$ORDER(^NURSF(214,"AF","A",NL1))
- if NL1'>0
- QUIT
- FOR DA=0:0
- SET DA=$ORDER(^NURSF(214,"AF","A",NL1,DA))
- if DA'>0
- QUIT
- SET NDAT=$SELECT($DATA(^NURSF(214,DA,0)):^(0),1:"")
- SET DFN=$PIECE(NDAT,"^")
- if DFN'=""
- DO SORT1
- +1 QUIT
- SORT1 ;
- +1 if 'NURMDSW
- SET NURFAC(2)=" BLANK"
- +2 IF NURMDSW
- SET NURFAC(2)=$$EN12^NURSUT3($GET(NL1))
- +3 IF NURMDSW
- IF '$GET(NURFAC)
- IF $GET(NURFAC(1))'=$GET(NURFAC(2))
- QUIT
- +4 DO 1^VADPT
- if $EXTRACT(IOST)="C"
- WRITE "."
- SET NCLAS=$ORDER(^NURSA(214.6,"AA",DFN,""))
- IF NCLAS=""
- SET NCLAS=0
- GOTO A
- +5 DO EN6^NURSCUTL
- SET NURSCLAS("CL")=1
- DO EN2^NURSCUTL
- SET NCLAS=$SELECT(NURSCLAS="":"",$DATA(^NURSA(214.6,NURSCLAS,0)):^(0),1:"")
- A IF $PIECE($PIECE(NCLAS,"^"),".")<DT
- SET NBED=$SELECT($PIECE(NDAT,"^",4)="":"",$DATA(^NURSF(213.3,$PIECE(NDAT,"^",4),0)):$PIECE(^(0),"^"),1:"")
- IF NBED'="HEMODIALYSIS"
- IF NBED'="DOMICILIARY"
- IF NBED'="RECOVERY ROOM"
- Begin DoDot:1
- +1 SET NRMBD=$SELECT(VAIN(5)'="":VAIN(5),1:" BLANK")
- SET NNM=$SELECT(VADM(1)'="":VADM(1),1:" BLANK")
- SET SSN=$SELECT(+$GET(VADM(2))'="":$PIECE(VADM(2),U,2),1:" BLANK")
- +2 SET NPWARD=NL1
- DO EN6^NURSAUTL
- SET NPWARD=$SELECT(NPWARD'="":NPWARD,1:" BLANK")
- SET ^TMP($JOB,NURFAC(2),NPWARD,NRMBD,NNM,+$PIECE(NCLAS,"^")_"--"_DFN,SSN)=""
- +3 QUIT
- End DoDot:1
- +4 QUIT
- WRTE ;
- +1 SET NURFAC(3)=""
- FOR
- SET NURFAC(3)=$ORDER(^TMP($JOB,NURFAC(3)))
- if NURFAC(3)=""!(NURQUIT)
- QUIT
- if NURSW1
- DO HEADER
- if NURQUIT
- QUIT
- DO AA
- if NURQUIT
- QUIT
- +2 QUIT
- AA SET NL1=""
- FOR
- SET NL1=$ORDER(^TMP($JOB,NURFAC(3),NL1))
- if NL1=""!(NURQUIT)
- QUIT
- if NURSW1
- WRITE !!,?5,"WARD: ",NL1
- SET NRMBD=""
- FOR
- SET NRMBD=$ORDER(^TMP($JOB,NURFAC(3),NL1,NRMBD))
- if NRMBD=""!NURQUIT
- QUIT
- Begin DoDot:1
- +1 SET NNM=""
- FOR
- SET NNM=$ORDER(^TMP($JOB,NURFAC(3),NL1,NRMBD,NNM))
- if NNM=""!NURQUIT
- QUIT
- SET NSUB=""
- FOR
- SET NSUB=$ORDER(^TMP($JOB,NURFAC(3),NL1,NRMBD,NNM,NSUB))
- if NSUB=""!NURQUIT
- QUIT
- SET SSN=""
- FOR
- SET SSN=$ORDER(^(NSUB,SSN))
- if SSN=""!NURQUIT
- QUIT
- Begin DoDot:2
- +2 IF 'NURSW1!($Y>(IOSL-4))
- DO HEADER
- if NURQUIT
- QUIT
- +3 SET NBR=1
- SET Y=$PIECE(NSUB,"--",1)
- if +Y
- DO D^DIQ
- SET NCLAS=$SELECT(Y'=0:Y,1:"NOT CLASSIFIED YET")
- +4 SET DFN=$PIECE(NSUB,"--",2)
- DO ^NURSAPCH
- +5 WRITE !!,$SELECT(NRMBD'=" BLANK":NRMBD,1:""),?18,$SELECT(NNM'=" BLANK":$EXTRACT(NNM,1,20),1:""),?48,NCLAS,?71,NURSX,!,?18,SSN
- +6 QUIT
- End DoDot:2
- if NURQUIT
- QUIT
- +7 QUIT
- End DoDot:1
- if NURQUIT
- QUIT
- +8 QUIT
- +1 IF NURSW1
- IF $EXTRACT(IOST)="C"
- IF 'NURQUEUE
- DO ENDPG^NURSUT1
- if NUROUT
- SET NURQUIT=+NUROUT
- if NURQUIT
- QUIT
- +2 SET NURSW1=1
- SET NURPAGE=NURPAGE+1
- +3 if $EXTRACT(IOST)="C"!(NURPAGE>1)
- WRITE @IOF
- +4 WRITE !,NDATE,?18,"CURRENT UNCLASSIFIED PATIENT REPORT FOR THE HOSPITAL",?72,"PAGE: "_NURPAGE
- +5 WRITE !!,"ROOM-BED",?18,"PATIENT",?50,"LAST CLASSIFIED",?70,"ABSENCE",!,?18,"SSN",!
- +6 FOR X=1:1:80
- WRITE "-"
- +7 IF NURMDSW
- WRITE !,?35,$SELECT($GET(NURFAC(3))=" BLANK":"NO FACLILTY",1:$GET(NURFAC(3)))
- +8 if NL1'=""
- WRITE !!,?5,"WARD: ",NL1
- +9 QUIT
