- NURARCR0 ;HIRMFO/RM/RD-VIEW PRINT OF PATIENT CLASSIFICATION ;1/17/89
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- EN1 ;
- Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
- S NURSSEL=0 G BGN
- EN2 ;
- Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
- S NURSSEL=1
- BGN ;
- S (NURQUEUE,NUROUT,NURSW1,NURQUIT,NURPAGE)=0
- S NASK=1,DIC(0)="EQMZ",NACT=0 D EN5^NURSCUTL I DFN="" S NUROUT=1 G QUIT
- D DEM^VADPT
- S SSN=VA("PID"),N1=VADM(1)
- D EN6^NURSCUTL
- I VAIN(7)'="" S NDFLT=$P(VAIN(7),"^",2)
- ENTADM ;
- S %DT("A")="Start date (time optional): ",%DT(0)=-DT,%DT("B")="T-7",%DT="AETX" D ^%DT K %DT I +Y'>0 S NUROUT=1 G QUIT
- S NADMDATE=+Y
- W ! S %DT("A")="Go to date (time optional): ",%DT="AETX",%DT("B")="NOW" D ^%DT K %DT I +Y'>0 S NUROUT=1 G QUIT
- S (X1,NURSDIS)=+Y,X2=NADMDATE D ^%DTC
- I X<0!(X=0&(((+("."_$P(NURSDIS,".",2))*10000)-((+("."_$P(NADMDATE,".",2))*10000)))'>0)) W !?5,"Ending date of range needs to be greater than starting date.",!?5,$C(7),"Please reenter!!" G ENTADM
- G:NURSSEL=0 DEV
- ENTWRD ;
- S DIC("A")="ENTER WARD: ",DIC="^NURSF(211.4,",DIC(0)="AEMQ",DIC("S")="I $S('$D(^(""I"")):1,$P(^(""I""),U)'=""I"":1,1:0),$S('$D(^(1)):1,$P(^(1),U)=""A"":1,1:0)" W ! D ^DIC K DIC I +Y'>0 S NUROUT=1 G QUIT
- S NURSW1=+Y
- S NCK=0 F X=0:0 S X=$O(^NURSA(214.6,"AA",DFN,X)) Q:(X'>0)!(NUROUT) S NURSCLAS=$O(^NURSA(214.6,"AA",DFN,X,"")) S:$D(^NURSA(214.6,"E",NURSW1,NURSCLAS)) NCK=1
- S NPWARD=+NURSW1 D EN6^NURSAUTL
- I 'NCK W !,*7,N1," NOT CLASSIFIED ON ",NPWARD,!,"FOR THIS ADMISSION DATE, PLEASE REENTER WARD." G ENTWRD
- DEV W ! S ZTRTN="START^NURARCR0" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
- START ;
- K ^TMP($J)
- F X=0:0 S X=$O(^NURSA(214.6,"AA",DFN,X)) Q:X'>0 F NURSCLAS=0:0 S NURSCLAS=$O(^NURSA(214.6,"AA",DFN,X,NURSCLAS)) Q:NURSCLAS'>0 D SORT
- S X=$O(^TMP($J,"")) I X="" S NUROUT=1,NL1="" D HEADER^NURARCR1 W !!,"**** NO DATA FOR THIS REPORT ****" G QUIT
- PRINTIT U IO D ^NURARCR1
- QUIT K ^TMP($J) D CLOSE^NURSUT1,^NURAKILL
- Q
- SORT S NDATA=$S($D(^NURSA(214.6,NURSCLAS,0)):^(0),1:"") I NURSSEL Q:$P(NDATA,"^",8)'=NURSW1
- S CNDATE=$P(NDATA,"^")
- S NPWARD=$P(NDATA,"^",8) D EN6^NURSAUTL
- S CNWARD=$S($P(NDATA,"^",8)="":" BLANK",'$D(^NURSF(211.4,$P(NDATA,"^",8),0)):" BLANK",$P(^(0),"^")="":" BLANK",$D(NPWARD):NPWARD,1:" BLANK")
- S NBED=$S($P(NDATA,"^",9)="":"",$D(^NURSF(213.3,$P(NDATA,"^",9),0)):$P(^(0),"^"),1:"") Q:NBED=""!(NBED="HEMODIALYSIS")!(NBED="DOMICILIARY")!(NBED="RECOVERY ROOM")
- Q:'(CNDATE>NADMDATE&(CNDATE<NURSDIS))
- S ^TMP($J,CNWARD,CNDATE,NURSCLAS)=""
- Q
- NURARCR0 ;HIRMFO/RM/RD-VIEW PRINT OF PATIENT CLASSIFICATION ;1/17/89
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- EN1 ;
- +1 IF '$DATA(^DIC(213.9,1,"OFF"))
- QUIT
- IF $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
- QUIT
- +2 SET NURSSEL=0
- GOTO BGN
- EN2 ;
- +1 IF '$DATA(^DIC(213.9,1,"OFF"))
- QUIT
- IF $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
- QUIT
- +2 SET NURSSEL=1
- BGN ;
- +1 SET (NURQUEUE,NUROUT,NURSW1,NURQUIT,NURPAGE)=0
- +2 SET NASK=1
- SET DIC(0)="EQMZ"
- SET NACT=0
- DO EN5^NURSCUTL
- IF DFN=""
- SET NUROUT=1
- GOTO QUIT
- +3 DO DEM^VADPT
- +4 SET SSN=VA("PID")
- SET N1=VADM(1)
- +5 DO EN6^NURSCUTL
- +6 IF VAIN(7)'=""
- SET NDFLT=$PIECE(VAIN(7),"^",2)
- ENTADM ;
- +1 SET %DT("A")="Start date (time optional): "
- SET %DT(0)=-DT
- SET %DT("B")="T-7"
- SET %DT="AETX"
- DO ^%DT
- KILL %DT
- IF +Y'>0
- SET NUROUT=1
- GOTO QUIT
- +2 SET NADMDATE=+Y
- +3 WRITE !
- SET %DT("A")="Go to date (time optional): "
- SET %DT="AETX"
- SET %DT("B")="NOW"
- DO ^%DT
- KILL %DT
- IF +Y'>0
- SET NUROUT=1
- GOTO QUIT
- +4 SET (X1,NURSDIS)=+Y
- SET X2=NADMDATE
- DO ^%DTC
- +5 IF X<0!(X=0&(((+("."_$PIECE(NURSDIS,".",2))*10000)-((+("."_$PIECE(NADMDATE,".",2))*10000)))'>0))
- WRITE !?5,"Ending date of range needs to be greater than starting date.",!?5,$CHAR(7),"Please reenter!!"
- GOTO ENTADM
- +6 IF NURSSEL=0
- GOTO DEV
- ENTWRD ;
- +1 SET DIC("A")="ENTER WARD: "
- SET DIC="^NURSF(211.4,"
- SET DIC(0)="AEMQ"
- SET DIC("S")="I $S('$D(^(""I"")):1,$P(^(""I""),U)'=""I"":1,1:0),$S('$D(^(1)):1,$P(^(1),U)=""A"":1,1:0)"
- WRITE !
- DO ^DIC
- KILL DIC
- IF +Y'>0
- SET NUROUT=1
- GOTO QUIT
- +2 SET NURSW1=+Y
- +3 SET NCK=0
- FOR X=0:0
- SET X=$ORDER(^NURSA(214.6,"AA",DFN,X))
- IF (X'>0)!(NUROUT)
- QUIT
- SET NURSCLAS=$ORDER(^NURSA(214.6,"AA",DFN,X,""))
- IF $DATA(^NURSA(214.6,"E",NURSW1,NURSCLAS))
- SET NCK=1
- +4 SET NPWARD=+NURSW1
- DO EN6^NURSAUTL
- +5 IF 'NCK
- WRITE !,*7,N1," NOT CLASSIFIED ON ",NPWARD,!,"FOR THIS ADMISSION DATE, PLEASE REENTER WARD."
- GOTO ENTWRD
- DEV WRITE !
- SET ZTRTN="START^NURARCR0"
- DO EN7^NURSUT0
- IF POP!($DATA(ZTSK))
- GOTO QUIT
- START ;
- +1 KILL ^TMP($JOB)
- +2 FOR X=0:0
- SET X=$ORDER(^NURSA(214.6,"AA",DFN,X))
- IF X'>0
- QUIT
- FOR NURSCLAS=0:0
- SET NURSCLAS=$ORDER(^NURSA(214.6,"AA",DFN,X,NURSCLAS))
- IF NURSCLAS'>0
- QUIT
- DO SORT
- +3 SET X=$ORDER(^TMP($JOB,""))
- IF X=""
- SET NUROUT=1
- SET NL1=""
- DO HEADER^NURARCR1
- WRITE !!,"**** NO DATA FOR THIS REPORT ****"
- GOTO QUIT
- PRINTIT USE IO
- DO ^NURARCR1
- QUIT KILL ^TMP($JOB)
- DO CLOSE^NURSUT1
- DO ^NURAKILL
- +1 QUIT
- SORT SET NDATA=$SELECT($DATA(^NURSA(214.6,NURSCLAS,0)):^(0),1:"")
- IF NURSSEL
- IF $PIECE(NDATA,"^",8)'=NURSW1
- QUIT
- +1 SET CNDATE=$PIECE(NDATA,"^")
- +2 SET NPWARD=$PIECE(NDATA,"^",8)
- DO EN6^NURSAUTL
- +3 SET CNWARD=$SELECT($PIECE(NDATA,"^",8)="":" BLANK",'$DATA(^NURSF(211.4,$PIECE(NDATA,"^",8),0)):" BLANK",$PIECE(^(0),"^")="":" BLANK",$DATA(NPWARD):NPWARD,1:" BLANK")
- +4 SET NBED=$SELECT($PIECE(NDATA,"^",9)="":"",$DATA(^NURSF(213.3,$PIECE(NDATA,"^",9),0)):$PIECE(^(0),"^"),1:"")
- IF NBED=""!(NBED="HEMODIALYSIS")!(NBED="DOMICILIARY")!(NBED="RECOVERY ROOM")
- QUIT
- +5 IF '(CNDATE>NADMDATE&(CNDATE<NURSDIS))
- QUIT
- +6 SET ^TMP($JOB,CNWARD,CNDATE,NURSCLAS)=""
- +7 QUIT