Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: NURCES0

NURCES0.m

Go to the documentation of this file.
  1. 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
  1. EN1 ;132 COLUMN FORMAT OF REPORT
  1. S NOPT=1,NURS132=1
  1. START0 G:'$D(^DIC(213.9,1,"OFF")) QUIT2 G:$P(^DIC(213.9,1,"OFF"),"^",1)=1 QUIT2
  1. 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
  1. S NURQUIT=0 K DIR
  1. S DIR("A")="Please enter the character of your choice: "
  1. S DIR("A",1)="Select shift for the report"
  1. S DIR("A",2)=" "
  1. S DIR("A",3)=" N - night"
  1. S DIR("A",4)=" D - day"
  1. S DIR("A",5)=" E - evening"
  1. S DIR("A",6)=" "
  1. S DIR(0)="SMA^N:night;D:day;E:evening"
  1. D ^DIR K DIR I $D(DIRUT) G QUIT2
  1. S NX=Y,GMRDAY=$P(^GMRD(126.95,1,1),"^",2),GMREVE=$P(^(1),"^",3),GMRNIT=$P(^(1),"^")
  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
  1. 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
  1. S:NX'="N" GMRFIN=GMRFIN-0.0001
  1. I NX="N",GMRNIT>2000 S X1=DT,X2=-1 D C^%DTC K %DTC S GMRSTRT=X_"."_GMRNIT
  1. W ! D WARDPAT^NURCUT0 S:NUREDB="" NUROUT=1 G:NURQUIT QUIT S:"Pp"'[NUREDB NURORDR=$$SORT^NURCES5("")
  1. G:NURQUIT QUIT D EN6^NURSUT0 G:NURQUIT QUIT W:NOPT=1 !,"THIS REPORT REQUIRES AN 132 COLUMN DEVICE - LAND!"
  1. W ! S ZTRTN="START^NURCES0",ZTDESC="NURSING END-OF-SHIFT REPORT" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
  1. START ;
  1. 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
  1. S NURNOW(1)=$$FMADD^XLFDT(NURNOW,-1)
  1. I $E(IOST)="P",NCOPY>1 D
  1. . F NURI=1:1 Q:NURI>NCOPY D REPORT W:NURI<NCOPY @IOF
  1. . Q
  1. E D REPORT
  1. QUIT ; KILL LOCAL VARIABLES
  1. D CLOSE^NURSUT1 K NURNOW,NURORDR
  1. QUIT2 K ^TMP($J) D KVAR^VADPT,^NURCKILL K NURMDSW
  1. Q
  1. REPORT U IO S (NURSW1,NURPAGE)=0 K ^TMP($J),^TMP("DIQ1",$J)
  1. D ^NURCAS2
  1. I '$D(^TMP($J,"NURCEN")) D HEADER^NURCES2 W $C(7),!,"NO PATIENTS IN SELECTED ROOM(S) ON "_NPWARD Q
  1. PRINT ;PRINT ROUTINE
  1. I "Pp"[NUREDB S (NURWARD,NPWARD)=+$P(^NURSF(214,+DFN,0),"^",3) D:NPWARD>0 EN6^NURSAUTL S NURORDR="SORT1"
  1. D @NURORDR
  1. Q
  1. SORT1 ;
  1. 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
  1. . 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")
  1. Q
  1. EN2 ;80 COLUMN FORMAT REPORT
  1. S NOPT=2 K NURS132 G START0
  1. ;
  1. SORT2 ;RESORT BY PATIENT NAME
  1. S NBED="" F S NBED=$O(^TMP($J,"NURCEN",NBED)) Q:NBED="" D
  1. . S NBED(0)="" F S NBED(0)=$O(^TMP($J,"NURCEN",NBED,NBED(0))) Q:NBED(0)="" D
  1. . . 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)
  1. 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
  1. . 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")
  1. Q
  1. SORT3 ;RESORT BY BED ORDER
  1. S NBED="" F S NBED=$O(^TMP($J,"NURCEN",NBED)) Q:NBED="" D
  1. . S NBED(0)="" F S NBED(0)=$O(^TMP($J,"NURCEN",NBED,NBED(0))) Q:NBED(0)="" D
  1. . . 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)
  1. 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
  1. . 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")
  1. Q