- NURACHDC ;HIRMFO/MD,FT-HEMODIALYSIS PATIENTS TO ACUITY TOTALS ; 3/20/03 12:44pm
- ;;4.0;NURSING SERVICE;**7,17,38**;Apr 25, 1997
- EN1 ;ADD HEMODIALYSIS PATIENT TO AMIS COUNT
- Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
- S HRSW=$O(^NURSF(213.3,"B","HEMODIALYSIS",0))_"^H",(NACT,NUROUT)=0 G PATCK
- EN2 ;ADD RECOVERY ROOM PATIENT TO AMIS COUNT
- Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^")=1
- S HRSW=$O(^NURSF(213.3,"B","RECOVERY ROOM",0))_"^R",NUROUT=0,NACT=1
- PATCK S NASK=1,DIC(0)="EQM" D EN5^NURSCUTL
- G:DFN'>0 QUIT
- S PATNAM=$P(Y,"^",2)
- S X="N",%DT="T" D ^%DT S NDATEX=+Y S:$E(NDATEX,8)'="." NDATEX=$E(NDATEX,1,7)_".00001" S NDATEX(0)=(+Y\1),HRSW(0)=$P(HRSW,U,2)
- F DA(1)=0:0 S DA(1)=$O(^NURSA(214.6,"ACNT",NDATEX(0),DA(1))) Q:DA(1)'>0!(NUROUT) F DA=0:0 S DA=$O(^NURSA(214.6,"ACNT",NDATEX(0),DA(1),HRSW(0),DA)) Q:DA'>0!(NUROUT) I $P(^NURSA(214.6,DA,0),U,2)=DFN D EDIT Q
- G:NUROUT QUIT
- D CONTPRO G:NUROUT QUIT
- G PATCK
- QUIT ; KILL LOCAL VARIABLES
- K ^TMP($J) D ^NURAKILL
- Q
- CONTPRO ; UPDATE ACUITY TOTALS
- W !,$S($P(HRSW,"^",2)="H":"The Nurse who performed the hemodialysis is from which unit: ",$P(HRSW,"^",2)="R":"Recovery Room Location: ",1:"")
- I $P(HRSW,"^",2)="R",+HRSW S NURDEFLT=$$LOCDEF^NURACHDC() W:NURDEFLT'="" NURDEFLT_"//"
- R WARD:DTIME
- I WARD["^"!'$T S NUROUT=1 Q
- I $D(NURDEFLT),WARD="" S WARD=NURDEFLT
- K NURDEFLT
- S X=WARD,DIC="^NURSF(211.4,",DIC(0)="QEMZ",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)" D ^DIC K DIC G:+Y'>0 CONTPRO
- S WARD=+Y
- LOCK S DA=($P(^NURSA(214.6,0),"^",3)+1) L +^NURSA(214.6,DA,0):0 I '$T!$D(^NURSA(214.6,DA)) G LOCK
- CHK I $$DUPCLAS^NURSCUTL($G(NDATEX),DFN) S NDATEX=(NDATEX+.00001) G CHK
- S X=NDATEX_"^"_DFN_"^"_1_"^"_"N/A"_"^"_"C"_"^"_DUZ_"^^"_WARD_"^"_HRSW,^NURSA(214.6,DA,0)=X
- S ^NURSA(214.6,"AA",$P(X,"^",2),9999999-$P(X,"^"),DA)=""
- S ^NURSA(214.6,"B",$E($P(X,"^",1),1,30),DA)=""
- S ^NURSA(214.6,"C",$E($P(X,"^",2),1,30),DA)=""
- S ^NURSA(214.6,"E",$E($P(X,"^",8),1,30),DA)=""
- S ^NURSA(214.6,"ACNT",$P(X,"^")\1,WARD,$E($P(X,"^",10),1,30),DA)=""
- S $P(^NURSA(214.6,0),"^",3,4)=DA_"^"_($P(^NURSA(214.6,0),"^",4)+1) L -^NURSA(214.6,DA,0)
- W !!,PATNAM," HAS BEEN ADDED TO THE "_$S($P(HRSW,"^",2)="H":"HEMODIALYSIS",$P(HRSW,"^",2)="R":"RECOVERY ROOM")_" COUNT."
- Q
- EDIT S NDATA=DA_"^"_^NURSA(214.6,DA,0) S Y=+$P(NDATA,U,2) D D^DIQ S NDATA(1)=Y W !!,"CLASSIFICATION DATE/TIME: "_Y_"//" R X:DTIME I X="^"!('$T) S NUROUT=1 Q
- I X="@" D DELETE Q
- S:X="" X=NDATA(1) S %DT="R" D ^%DT I X["?"!'((+Y\1)=($P(NDATA,U,2)\1)) W $C(7),!!,"Enter a date/time on "_$P(NDATA(1),"@") G EDIT
- S NDATEX(2)=+Y,DIE="^NURSA(214.6,",DR=".01////^S X=NDATEX(2);5//;6//" D ^DIE
- I '($P(NDATA,"^",2,11)=^NURSA(214.6,+DA,0)) S $P(^(0),"^",6)=DUZ
- S NUROUT=1
- Q
- DELETE W !!,$C(7),?3,"SURE YOU WANT TO DELETE THE "_NDATA(1)_" ENTRY " D YN^DICN I '(%>0) W !!,?5,"ANSWER YES OR NO" K % G DELETE
- I %=1 S DIK="^NURSA(214.6," D ^DIK S (DA,DA(1))=""
- S NUROUT=1 Q
- LOCDEF() ; find first active Nurs Location file (211.4) entry which has a
- ; Recovery Room bedsection
- N NURFOUND,NURBED,NURLOC S (NURFOUND,NURLOC)=0
- F S NURLOC=$O(^NURSF(211.4,"D","A",NURLOC)) Q:NURFOUND!(NURLOC'>0) D Q:NURFOUND
- . S NURBED=0 F S NURBED=$O(^NURSF(211.4,NURLOC,4,NURBED)) Q:NURFOUND!(NURBED'>0) I +$P($G(^NURSF(211.4,NURLOC,4,NURBED,0)),U)=+HRSW S NURFOUND=1
- . Q
- Q $S(NURFOUND=1:$P($G(^SC($P(^NURSF(211.4,+NURLOC,0),U),0)),U),1:"")
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURACHDC 3478 printed Apr 23, 2025@18:33:36 Page 2
- NURACHDC ;HIRMFO/MD,FT-HEMODIALYSIS PATIENTS TO ACUITY TOTALS ; 3/20/03 12:44pm
- +1 ;;4.0;NURSING SERVICE;**7,17,38**;Apr 25, 1997
- EN1 ;ADD HEMODIALYSIS PATIENT TO AMIS COUNT
- +1 if '$DATA(^DIC(213.9,1,"OFF"))
- QUIT
- if $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
- QUIT
- +2 SET HRSW=$ORDER(^NURSF(213.3,"B","HEMODIALYSIS",0))_"^H"
- SET (NACT,NUROUT)=0
- GOTO PATCK
- EN2 ;ADD RECOVERY ROOM PATIENT TO AMIS COUNT
- +1 if '$DATA(^DIC(213.9,1,"OFF"))
- QUIT
- if $PIECE(^DIC(213.9,1,"OFF"),"^")=1
- QUIT
- +2 SET HRSW=$ORDER(^NURSF(213.3,"B","RECOVERY ROOM",0))_"^R"
- SET NUROUT=0
- SET NACT=1
- PATCK SET NASK=1
- SET DIC(0)="EQM"
- DO EN5^NURSCUTL
- +1 if DFN'>0
- GOTO QUIT
- +2 SET PATNAM=$PIECE(Y,"^",2)
- +3 SET X="N"
- SET %DT="T"
- DO ^%DT
- SET NDATEX=+Y
- if $EXTRACT(NDATEX,8)'="."
- SET NDATEX=$EXTRACT(NDATEX,1,7)_".00001"
- SET NDATEX(0)=(+Y\1)
- SET HRSW(0)=$PIECE(HRSW,U,2)
- +4 FOR DA(1)=0:0
- SET DA(1)=$ORDER(^NURSA(214.6,"ACNT",NDATEX(0),DA(1)))
- if DA(1)'>0!(NUROUT)
- QUIT
- FOR DA=0:0
- SET DA=$ORDER(^NURSA(214.6,"ACNT",NDATEX(0),DA(1),HRSW(0),DA))
- if DA'>0!(NUROUT)
- QUIT
- IF $PIECE(^NURSA(214.6,DA,0),U,2)=DFN
- DO EDIT
- QUIT
- +5 if NUROUT
- GOTO QUIT
- +6 DO CONTPRO
- if NUROUT
- GOTO QUIT
- +7 GOTO PATCK
- QUIT ; KILL LOCAL VARIABLES
- +1 KILL ^TMP($JOB)
- DO ^NURAKILL
- +2 QUIT
- CONTPRO ; UPDATE ACUITY TOTALS
- +1 WRITE !,$SELECT($PIECE(HRSW,"^",2)="H":"The Nurse who performed the hemodialysis is from which unit: ",$PIECE(HRSW,"^",2)="R":"Recovery Room Location: ",1:"")
- +2 IF $PIECE(HRSW,"^",2)="R"
- IF +HRSW
- SET NURDEFLT=$$LOCDEF^NURACHDC()
- if NURDEFLT'=""
- WRITE NURDEFLT_"//"
- +3 READ WARD:DTIME
- +4 IF WARD["^"!'$TEST
- SET NUROUT=1
- QUIT
- +5 IF $DATA(NURDEFLT)
- IF WARD=""
- SET WARD=NURDEFLT
- +6 KILL NURDEFLT
- +7 SET X=WARD
- SET DIC="^NURSF(211.4,"
- SET DIC(0)="QEMZ"
- 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)"
- DO ^DIC
- KILL DIC
- if +Y'>0
- GOTO CONTPRO
- +8 SET WARD=+Y
- LOCK SET DA=($PIECE(^NURSA(214.6,0),"^",3)+1)
- LOCK +^NURSA(214.6,DA,0):0
- IF '$TEST!$DATA(^NURSA(214.6,DA))
- GOTO LOCK
- CHK IF $$DUPCLAS^NURSCUTL($GET(NDATEX),DFN)
- SET NDATEX=(NDATEX+.00001)
- GOTO CHK
- +1 SET X=NDATEX_"^"_DFN_"^"_1_"^"_"N/A"_"^"_"C"_"^"_DUZ_"^^"_WARD_"^"_HRSW
- SET ^NURSA(214.6,DA,0)=X
- +2 SET ^NURSA(214.6,"AA",$PIECE(X,"^",2),9999999-$PIECE(X,"^"),DA)=""
- +3 SET ^NURSA(214.6,"B",$EXTRACT($PIECE(X,"^",1),1,30),DA)=""
- +4 SET ^NURSA(214.6,"C",$EXTRACT($PIECE(X,"^",2),1,30),DA)=""
- +5 SET ^NURSA(214.6,"E",$EXTRACT($PIECE(X,"^",8),1,30),DA)=""
- +6 SET ^NURSA(214.6,"ACNT",$PIECE(X,"^")\1,WARD,$EXTRACT($PIECE(X,"^",10),1,30),DA)=""
- +7 SET $PIECE(^NURSA(214.6,0),"^",3,4)=DA_"^"_($PIECE(^NURSA(214.6,0),"^",4)+1)
- LOCK -^NURSA(214.6,DA,0)
- +8 WRITE !!,PATNAM," HAS BEEN ADDED TO THE "_$SELECT($PIECE(HRSW,"^",2)="H":"HEMODIALYSIS",$PIECE(HRSW,"^",2)="R":"RECOVERY ROOM")_" COUNT."
- +9 QUIT
- EDIT SET NDATA=DA_"^"_^NURSA(214.6,DA,0)
- SET Y=+$PIECE(NDATA,U,2)
- DO D^DIQ
- SET NDATA(1)=Y
- WRITE !!,"CLASSIFICATION DATE/TIME: "_Y_"//"
- READ X:DTIME
- IF X="^"!('$TEST)
- SET NUROUT=1
- QUIT
- +1 IF X="@"
- DO DELETE
- QUIT
- +2 if X=""
- SET X=NDATA(1)
- SET %DT="R"
- DO ^%DT
- IF X["?"!'((+Y\1)=($PIECE(NDATA,U,2)\1))
- WRITE $CHAR(7),!!,"Enter a date/time on "_$PIECE(NDATA(1),"@")
- GOTO EDIT
- +3 SET NDATEX(2)=+Y
- SET DIE="^NURSA(214.6,"
- SET DR=".01////^S X=NDATEX(2);5//;6//"
- DO ^DIE
- +4 IF '($PIECE(NDATA,"^",2,11)=^NURSA(214.6,+DA,0))
- SET $PIECE(^(0),"^",6)=DUZ
- +5 SET NUROUT=1
- +6 QUIT
- DELETE WRITE !!,$CHAR(7),?3,"SURE YOU WANT TO DELETE THE "_NDATA(1)_" ENTRY "
- DO YN^DICN
- IF '(%>0)
- WRITE !!,?5,"ANSWER YES OR NO"
- KILL %
- GOTO DELETE
- +1 IF %=1
- SET DIK="^NURSA(214.6,"
- DO ^DIK
- SET (DA,DA(1))=""
- +2 SET NUROUT=1
- QUIT
- LOCDEF() ; find first active Nurs Location file (211.4) entry which has a
- +1 ; Recovery Room bedsection
- +2 NEW NURFOUND,NURBED,NURLOC
- SET (NURFOUND,NURLOC)=0
- +3 FOR
- SET NURLOC=$ORDER(^NURSF(211.4,"D","A",NURLOC))
- if NURFOUND!(NURLOC'>0)
- QUIT
- Begin DoDot:1
- +4 SET NURBED=0
- FOR
- SET NURBED=$ORDER(^NURSF(211.4,NURLOC,4,NURBED))
- if NURFOUND!(NURBED'>0)
- QUIT
- IF +$PIECE($GET(^NURSF(211.4,NURLOC,4,NURBED,0)),U)=+HRSW
- SET NURFOUND=1
- +5 QUIT
- End DoDot:1
- if NURFOUND
- QUIT
- +6 QUIT $SELECT(NURFOUND=1:$PIECE($GET(^SC($PIECE(^NURSF(211.4,+NURLOC,0),U),0)),U),1:"")
- +7 ;
