- NURCES0 ;HIRMFO/YH,RM,FT,YH-END OF SHIFT REPORT PART 1/1 ;6/25/97 14:35
- ;;4.0;NURSING SERVICE;**2**;Apr 25, 1997
- EN1 ;132 COLUMN FORMAT OF REPORT
- S NOPT=1,NURS132=1
- START0 G:'$D(^DIC(213.9,1,"OFF")) QUIT2 G:$P(^DIC(213.9,1,"OFF"),"^",1)=1 QUIT2
- I '$D(^GMRD(126.95,1,1)) W !,"The Nursing shift parameters in ^GMRD(126.95) must be completed.",!,"Please contact the Nursing ADP Coordinator",! G QUIT2
- S NURQUIT=0 K DIR
- S DIR("A")="Please enter the character of your choice: "
- S DIR("A",1)="Select shift for the report"
- S DIR("A",2)=" "
- S DIR("A",3)=" N - night"
- S DIR("A",4)=" D - day"
- S DIR("A",5)=" E - evening"
- S DIR("A",6)=" "
- S DIR(0)="SMA^N:night;D:day;E:evening"
- D ^DIR K DIR I $D(DIRUT) G QUIT2
- S NX=Y,GMRDAY=$P(^GMRD(126.95,1,1),"^",2),GMREVE=$P(^(1),"^",3),GMRNIT=$P(^(1),"^")
- I GMRDAY=""!(GMREVE="")!(GMRNIT="") W !,"The Nursing shift parameters in ^GMRD(126.95) must be completed.",!,"Please contact the Nursing ADP Coordinator",! G QUIT2
- S GMRSTRT=$S(NX="N":DT,NX="D":DT_"."_GMRDAY,NX="E":DT_"."_GMREVE,1:"") G:GMRSTRT="" QUIT S GMRFIN=$S(NX="N":DT_"."_GMRDAY,NX="D":DT_"."_GMREVE,NX="E":DT_".2400",1:"") G:GMRFIN="" QUIT
- S:NX'="N" GMRFIN=GMRFIN-0.0001
- I NX="N",GMRNIT>2000 S X1=DT,X2=-1 D C^%DTC K %DTC S GMRSTRT=X_"."_GMRNIT
- W ! D WARDPAT^NURCUT0 S:NUREDB="" NUROUT=1 G:NURQUIT QUIT S:"Pp"'[NUREDB NURORDR=$$SORT^NURCES5("")
- G:NURQUIT QUIT D EN6^NURSUT0 G:NURQUIT QUIT W:NOPT=1 !,"THIS REPORT REQUIRES AN 132 COLUMN DEVICE - LAND!"
- W ! S ZTRTN="START^NURCES0",ZTDESC="NURSING END-OF-SHIFT REPORT" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
- START ;
- S GPACK=1,X="GMRYRP0" X ^%ZOSF("TEST") S:'$T GPACK=0 S GFH=1,X="FHWHEA" X ^%ZOSF("TEST") S:'$T GFH=0 S $P(NURX,"-",130)="" D NOW^%DTC S NURNOW=%,Y=$E(%,1,12) X ^DD("DD") S NURDT=Y
- S NURNOW(1)=$$FMADD^XLFDT(NURNOW,-1)
- I $E(IOST)="P",NCOPY>1 D
- . F NURI=1:1 Q:NURI>NCOPY D REPORT W:NURI<NCOPY @IOF
- . Q
- E D REPORT
- QUIT ; KILL LOCAL VARIABLES
- D CLOSE^NURSUT1 K NURNOW,NURORDR
- QUIT2 K ^TMP($J) D KVAR^VADPT,^NURCKILL K NURMDSW
- Q
- REPORT U IO S (NURSW1,NURPAGE)=0 K ^TMP($J),^TMP("DIQ1",$J)
- D ^NURCAS2
- I '$D(^TMP($J,"NURCEN")) D HEADER^NURCES2 W $C(7),!,"NO PATIENTS IN SELECTED ROOM(S) ON "_NPWARD Q
- PRINT ;PRINT ROUTINE
- I "Pp"[NUREDB S (NURWARD,NPWARD)=+$P(^NURSF(214,+DFN,0),"^",3) D:NPWARD>0 EN6^NURSAUTL S NURORDR="SORT1"
- D @NURORDR
- Q
- SORT1 ;
- S NBED="" F S NBED=$O(^TMP($J,"NURCEN",NBED)) Q:NBED=""!(NURQUIT) I NBED'="GMRY" S NBED(0)="" F S NBED(0)=$O(^TMP($J,"NURCEN",NBED,NBED(0))) Q:NBED(0)=""!(NURQUIT) D
- . D:'NURSW1 HEADER^NURCES2 S N1="" F S N1=$O(^TMP($J,"NURCEN",NBED,NBED(0),N1)) Q:N1=""!(NURQUIT) K NPT,NSS,NADM,NCL,NPR S NDATA=^(N1),DFN=$P(NDATA,"^"),NSSN=$P(NDATA,"^",2) D PRINT1^NURCES01 K ^TMP($J,"GMRY")
- Q
- EN2 ;80 COLUMN FORMAT REPORT
- S NOPT=2 K NURS132 G START0
- ;
- SORT2 ;RESORT BY PATIENT NAME
- S NBED="" F S NBED=$O(^TMP($J,"NURCEN",NBED)) Q:NBED="" D
- . S NBED(0)="" F S NBED(0)=$O(^TMP($J,"NURCEN",NBED,NBED(0))) Q:NBED(0)="" D
- . . S N1="" F S N1=$O(^TMP($J,"NURCEN",NBED,NBED(0),N1)) Q:N1="" S ^TMP($J,"NSORT",N1,$P(NBED,"-"),NBED(0))=^TMP($J,"NURCEN",NBED,NBED(0),N1)
- S N1="" F S N1=$O(^TMP($J,"NSORT",N1)) Q:N1=""!(NURQUIT) I N1'="GMRY" S NBED="" F S NBED=$O(^TMP($J,"NSORT",N1,NBED)) Q:NBED=""!(NURQUIT) D
- . D:'NURSW1 HEADER^NURCES2 Q:NURQUIT S NBED(0)="" F S NBED(0)=$O(^TMP($J,"NSORT",N1,NBED,NBED(0))) Q:NBED(0)=""!(NURQUIT) K NPT,NSS,NADM,NCL,NPR S NDATA=^(NBED(0)),DFN=$P(NDATA,"^"),NSSN=$P(NDATA,"^",2) D PRINT1^NURCES01 K ^TMP($J,"GMRY")
- Q
- SORT3 ;RESORT BY BED ORDER
- S NBED="" F S NBED=$O(^TMP($J,"NURCEN",NBED)) Q:NBED="" D
- . S NBED(0)="" F S NBED(0)=$O(^TMP($J,"NURCEN",NBED,NBED(0))) Q:NBED(0)="" D
- . . S N1="" F S N1=$O(^TMP($J,"NURCEN",NBED,NBED(0),N1)) Q:N1="" S ^TMP($J,"NSORT",NBED(0),$P(NBED,"-"),N1)=^TMP($J,"NURCEN",NBED,NBED(0),N1)
- S NBED(0)="" F S NBED(0)=$O(^TMP($J,"NSORT",NBED(0))) Q:NBED(0)=""!(NURQUIT) I NBED(0)'="GMRY" S NBED="" F S NBED=$O(^TMP($J,"NSORT",NBED(0),NBED)) Q:NBED=""!(NURQUIT) D
- . D:'NURSW1 HEADER^NURCES2 Q:NURQUIT S N1="" F S N1=$O(^TMP($J,"NSORT",NBED(0),NBED,N1)) Q:N1=""!(NURQUIT) K NPT,NSS,NADM,NCL,NPR S NDATA=^(N1),DFN=$P(NDATA,"^"),NSSN=$P(NDATA,"^",2) D PRINT1^NURCES01 K ^TMP($J,"GMRY")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCES0 4277 printed Feb 18, 2025@23:46:45 Page 2
- NURCES0 ;HIRMFO/YH,RM,FT,YH-END OF SHIFT REPORT PART 1/1 ;6/25/97 14:35
- +1 ;;4.0;NURSING SERVICE;**2**;Apr 25, 1997
- EN1 ;132 COLUMN FORMAT OF REPORT
- +1 SET NOPT=1
- SET NURS132=1
- START0 if '$DATA(^DIC(213.9,1,"OFF"))
- GOTO QUIT2
- if $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
- GOTO QUIT2
- +1 IF '$DATA(^GMRD(126.95,1,1))
- WRITE !,"The Nursing shift parameters in ^GMRD(126.95) must be completed.",!,"Please contact the Nursing ADP Coordinator",!
- GOTO QUIT2
- +2 SET NURQUIT=0
- KILL DIR
- +3 SET DIR("A")="Please enter the character of your choice: "
- +4 SET DIR("A",1)="Select shift for the report"
- +5 SET DIR("A",2)=" "
- +6 SET DIR("A",3)=" N - night"
- +7 SET DIR("A",4)=" D - day"
- +8 SET DIR("A",5)=" E - evening"
- +9 SET DIR("A",6)=" "
- +10 SET DIR(0)="SMA^N:night;D:day;E:evening"
- +11 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- GOTO QUIT2
- +12 SET NX=Y
- SET GMRDAY=$PIECE(^GMRD(126.95,1,1),"^",2)
- SET GMREVE=$PIECE(^(1),"^",3)
- SET GMRNIT=$PIECE(^(1),"^")
- +13 IF GMRDAY=""!(GMREVE="")!(GMRNIT="")
- WRITE !,"The Nursing shift parameters in ^GMRD(126.95) must be completed.",!,"Please contact the Nursing ADP Coordinator",!
- GOTO QUIT2
- +14 SET GMRSTRT=$SELECT(NX="N":DT,NX="D":DT_"."_GMRDAY,NX="E":DT_"."_GMREVE,1:"")
- if GMRSTRT=""
- GOTO QUIT
- SET GMRFIN=$SELECT(NX="N":DT_"."_GMRDAY,NX="D":DT_"."_GMREVE,NX="E":DT_".2400",1:"")
- if GMRFIN=""
- GOTO QUIT
- +15 if NX'="N"
- SET GMRFIN=GMRFIN-0.0001
- +16 IF NX="N"
- IF GMRNIT>2000
- SET X1=DT
- SET X2=-1
- DO C^%DTC
- KILL %DTC
- SET GMRSTRT=X_"."_GMRNIT
- +17 WRITE !
- DO WARDPAT^NURCUT0
- if NUREDB=""
- SET NUROUT=1
- if NURQUIT
- GOTO QUIT
- if "Pp"'[NUREDB
- SET NURORDR=$$SORT^NURCES5("")
- +18 if NURQUIT
- GOTO QUIT
- DO EN6^NURSUT0
- if NURQUIT
- GOTO QUIT
- if NOPT=1
- WRITE !,"THIS REPORT REQUIRES AN 132 COLUMN DEVICE - LAND!"
- +19 WRITE !
- SET ZTRTN="START^NURCES0"
- SET ZTDESC="NURSING END-OF-SHIFT REPORT"
- DO EN7^NURSUT0
- if POP!($DATA(ZTSK))
- GOTO QUIT
- START ;
- +1 SET GPACK=1
- SET X="GMRYRP0"
- XECUTE ^%ZOSF("TEST")
- if '$TEST
- SET GPACK=0
- SET GFH=1
- SET X="FHWHEA"
- XECUTE ^%ZOSF("TEST")
- if '$TEST
- SET GFH=0
- SET $PIECE(NURX,"-",130)=""
- DO NOW^%DTC
- SET NURNOW=%
- SET Y=$EXTRACT(%,1,12)
- XECUTE ^DD("DD")
- SET NURDT=Y
- +2 SET NURNOW(1)=$$FMADD^XLFDT(NURNOW,-1)
- +3 IF $EXTRACT(IOST)="P"
- IF NCOPY>1
- Begin DoDot:1
- +4 FOR NURI=1:1
- if NURI>NCOPY
- QUIT
- DO REPORT
- if NURI<NCOPY
- WRITE @IOF
- +5 QUIT
- End DoDot:1
- +6 IF '$TEST
- DO REPORT
- QUIT ; KILL LOCAL VARIABLES
- +1 DO CLOSE^NURSUT1
- KILL NURNOW,NURORDR
- QUIT2 KILL ^TMP($JOB)
- DO KVAR^VADPT
- DO ^NURCKILL
- KILL NURMDSW
- +1 QUIT
- REPORT USE IO
- SET (NURSW1,NURPAGE)=0
- KILL ^TMP($JOB),^TMP("DIQ1",$JOB)
- +1 DO ^NURCAS2
- +2 IF '$DATA(^TMP($JOB,"NURCEN"))
- DO HEADER^NURCES2
- WRITE $CHAR(7),!,"NO PATIENTS IN SELECTED ROOM(S) ON "_NPWARD
- QUIT
- PRINT ;PRINT ROUTINE
- +1 IF "Pp"[NUREDB
- SET (NURWARD,NPWARD)=+$PIECE(^NURSF(214,+DFN,0),"^",3)
- if NPWARD>0
- DO EN6^NURSAUTL
- SET NURORDR="SORT1"
- +2 DO @NURORDR
- +3 QUIT
- SORT1 ;
- +1 SET NBED=""
- FOR
- SET NBED=$ORDER(^TMP($JOB,"NURCEN",NBED))
- if NBED=""!(NURQUIT)
- QUIT
- IF NBED'="GMRY"
- SET NBED(0)=""
- FOR
- SET NBED(0)=$ORDER(^TMP($JOB,"NURCEN",NBED,NBED(0)))
- if NBED(0)=""!(NURQUIT)
- QUIT
- Begin DoDot:1
- +2 if 'NURSW1
- DO HEADER^NURCES2
- SET N1=""
- FOR
- SET N1=$ORDER(^TMP($JOB,"NURCEN",NBED,NBED(0),N1))
- if N1=""!(NURQUIT)
- QUIT
- KILL NPT,NSS,NADM,NCL,NPR
- SET NDATA=^(N1)
- SET DFN=$PIECE(NDATA,"^")
- SET NSSN=$PIECE(NDATA,"^",2)
- DO PRINT1^NURCES01
- KILL ^TMP($JOB,"GMRY")
- End DoDot:1
- +3 QUIT
- EN2 ;80 COLUMN FORMAT REPORT
- +1 SET NOPT=2
- KILL NURS132
- GOTO START0
- +2 ;
- SORT2 ;RESORT BY PATIENT NAME
- +1 SET NBED=""
- FOR
- SET NBED=$ORDER(^TMP($JOB,"NURCEN",NBED))
- if NBED=""
- QUIT
- Begin DoDot:1
- +2 SET NBED(0)=""
- FOR
- SET NBED(0)=$ORDER(^TMP($JOB,"NURCEN",NBED,NBED(0)))
- if NBED(0)=""
- QUIT
- Begin DoDot:2
- +3 SET N1=""
- FOR
- SET N1=$ORDER(^TMP($JOB,"NURCEN",NBED,NBED(0),N1))
- if N1=""
- QUIT
- SET ^TMP($JOB,"NSORT",N1,$PIECE(NBED,"-"),NBED(0))=^TMP($JOB,"NURCEN",NBED,NBED(0),N1)
- End DoDot:2
- End DoDot:1
- +4 SET N1=""
- FOR
- SET N1=$ORDER(^TMP($JOB,"NSORT",N1))
- if N1=""!(NURQUIT)
- QUIT
- IF N1'="GMRY"
- SET NBED=""
- FOR
- SET NBED=$ORDER(^TMP($JOB,"NSORT",N1,NBED))
- if NBED=""!(NURQUIT)
- QUIT
- Begin DoDot:1
- +5 if 'NURSW1
- DO HEADER^NURCES2
- if NURQUIT
- QUIT
- SET NBED(0)=""
- FOR
- SET NBED(0)=$ORDER(^TMP($JOB,"NSORT",N1,NBED,NBED(0)))
- if NBED(0)=""!(NURQUIT)
- QUIT
- KILL NPT,NSS,NADM,NCL,NPR
- SET NDATA=^(NBED(0))
- SET DFN=$PIECE(NDATA,"^")
- SET NSSN=$PIECE(NDATA,"^",2)
- DO PRINT1^NURCES01
- KILL ^TMP($JOB,"GMRY")
- End DoDot:1
- +6 QUIT
- SORT3 ;RESORT BY BED ORDER
- +1 SET NBED=""
- FOR
- SET NBED=$ORDER(^TMP($JOB,"NURCEN",NBED))
- if NBED=""
- QUIT
- Begin DoDot:1
- +2 SET NBED(0)=""
- FOR
- SET NBED(0)=$ORDER(^TMP($JOB,"NURCEN",NBED,NBED(0)))
- if NBED(0)=""
- QUIT
- Begin DoDot:2
- +3 SET N1=""
- FOR
- SET N1=$ORDER(^TMP($JOB,"NURCEN",NBED,NBED(0),N1))
- if N1=""
- QUIT
- SET ^TMP($JOB,"NSORT",NBED(0),$PIECE(NBED,"-"),N1)=^TMP($JOB,"NURCEN",NBED,NBED(0),N1)
- End DoDot:2
- End DoDot:1
- +4 SET NBED(0)=""
- FOR
- SET NBED(0)=$ORDER(^TMP($JOB,"NSORT",NBED(0)))
- if NBED(0)=""!(NURQUIT)
- QUIT
- IF NBED(0)'="GMRY"
- SET NBED=""
- FOR
- SET NBED=$ORDER(^TMP($JOB,"NSORT",NBED(0),NBED))
- if NBED=""!(NURQUIT)
- QUIT
- Begin DoDot:1
- +5 if 'NURSW1
- DO HEADER^NURCES2
- if NURQUIT
- QUIT
- SET N1=""
- FOR
- SET N1=$ORDER(^TMP($JOB,"NSORT",NBED(0),NBED,N1))
- if N1=""!(NURQUIT)
- QUIT
- KILL NPT,NSS,NADM,NCL,NPR
- SET NDATA=^(N1)
- SET DFN=$PIECE(NDATA,"^")
- SET NSSN=$PIECE(NDATA,"^",2)
- DO PRINT1^NURCES01
- KILL ^TMP($JOB,"GMRY")
- End DoDot:1
- +6 QUIT