BDGADD ; IHS/ANMC/LJF - A&D DETAILED PRINT ; [ 06/11/2002 2:27 PM ]
;;5.3;PIMS;**1013**;APR 26, 2002
;
; Assumes VA variables RD and GL and set
;
I $E(IOST,1,2)="P-" S BDGT=RD D INIT,PRINT Q
;
EN ; -- main entry point for BDG A&D DETAILED
NEW VALMCNT,BDGT
D TERM^VALM0,CLEAR^VALM1
S BDGT=RD ;reset run date
D EN^VALM("BDG A&D DETAILED")
D CLEAR^VALM1
Q
;
HDR ; -- header code
S VALMHDR(1)=$$SP(15)_$$CONF^BDGF
S X="ADMISSIONS & DISCHARGES for "_$$GET1^DIQ(4,DUZ(2),.01)
S VALMHDR(2)=$$SP(79-$L(X)\2)_X
S VALMHDR(3)=$$SP(12)="For "_$$DOW^XLFDT(BDGT)_" "_$$FMTE^XLFDT(BDGT,2)
Q
;
INIT ; -- init variables and list array
NEW SRV,PREV,SRVN,TOT,TOT1,TOT2
K ^TMP("BDGADD",$J)
S VALMCNT=0
S PREV=$$FMADD^XLFDT(BDGT,-1) ;previous date
S (TOT1,TOT2)=0 F I="O","I","N","D" S TOT(I)="" ;initialize totals
;
D REMAIN ;display total patients remaining at end of day
D HDG ;display column headings
D PATDATA^BDGADD1 ;display patients
;
Q
;
;
SET(DATA,NUM) ; put display line into array
S NUM=NUM+1
S ^TMP("BDGADD",$J,NUM,0)=DATA
Q
;
REMAIN ; total up patients remaining at end of day
; count by service to pull out newborns and oberservations
NEW COUNT,I,SV,SNM,SUB,LINE,N
F I="I","O","N","D" S COUNT(I)=0
S SV=0 F S SV=$O(^BDGCTX(SV)) Q:'SV D
. S N=$G(^BDGCTX(SV,1,BDGT,0)) I N="" Q
. S SNM=$$GET1^DIQ(45.7,SV,.01) ;service name
. S SUB=$S(SNM="NEWBORN":"N",SNM["OBSERVATION":"O",SNM="DAY SURGERY":"D",1:"I")
. S COUNT(SUB)=COUNT(SUB)+$P(N,U,2)+$P(N,U,12)
;
S LINE="Inpatients:"_COUNT("I")
S LINE=$$PAD(LINE,25)_"Observations: "_COUNT("O")
S LINE=$$PAD(LINE,55)_"Day Surgerys: "_COUNT("D") ;ihs/cmi/maw 09/14/2011 patch 1013
S LINE=$$PAD(LINE,85)_"Newborns: "_COUNT("N")
D SET(LINE,.VALMCNT),SET("",.VALMCNT)
Q
;
HDG ; set up column headings
NEW LINE
;
;IHS/ANMC/LJF 6/11/2002 added PCP so column headings must change
;changed 25 -> 27, 34 -> 35 (LJF7 6/11/2002)
S LINE=$$PAD($$PAD(" NAME",27)_" HRCN",35)_"AGE"
;changed 63 -> 58 (LJF7 6/11/2002)
S LINE=$$PAD($$PAD(LINE,40)_"COMMUNITY",58)_"WARD SERV"
;changed 80 -> 72 and added code (LJF7 6/11/2002)
S LINE=$$PAD($$PAD(LINE,72)_"PROVIDER",92)_"PRIM CARE PRV"
;IHS/ANMC/LJF 6/11/2002 end of mods
;
D SET(LINE,.VALMCNT),SET($$REPEAT^XLFSTR("-",110),.VALMCNT)
Q
;
PRINT ; print report to paper
NEW BDGX,BDGLN,WARD
U IO D PHDG
;
; loop thru display array
S BDGX=0 F S BDGX=$O(^TMP("BDGADD",$J,BDGX)) Q:'BDGX D
. ;I $Y>(IOSL-4) D PHDG ;IHS/ANMC/LJF 6/5/2002 form feed at bottom of page (LJF7 6/11/2002)
. I $Y>(IOSL-4) W @IOF D PHDG ;IHS/ANMC/LJF 6/5/2002 form feed at bottom of page (LJF7 6/11/2002)
. W !,^TMP("BDGADD",$J,BDGX,0)
D ^%ZISC,EXIT
Q
;
PHDG ; heading for paper report
;D HDR W @IOF ;IHS/ANMC/LJF 6/5/2002 no form feed at beginning (LJF7 6/11/2002)
D HDR ;IHS/ANMC/LJF 6/5/2002 no form feed at beginning (LJF7 6/11/2002)
F I=1:1 Q:'$D(VALMHDR(I)) W !,VALMHDR(I)
W !,$$REPEAT^XLFSTR("=",80)
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("BDGADD",$J) K BDGREP
Q
;
EXPND ; -- expand code
Q
;
PAD(D,L) ;EP -- SUBRTN to pad length of data
; -- D=data L=length
Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
;
SP(N) ; -- SUBRTN to pad N number of spaces
Q $$PAD(" ",N)
BDGADD ; IHS/ANMC/LJF - A&D DETAILED PRINT ; [ 06/11/2002 2:27 PM ]
+1 ;;5.3;PIMS;**1013**;APR 26, 2002
+2 ;
+3 ; Assumes VA variables RD and GL and set
+4 ;
+5 IF $EXTRACT(IOST,1,2)="P-"
SET BDGT=RD
DO INIT
DO PRINT
QUIT
+6 ;
EN ; -- main entry point for BDG A&D DETAILED
+1 NEW VALMCNT,BDGT
+2 DO TERM^VALM0
DO CLEAR^VALM1
+3 ;reset run date
SET BDGT=RD
+4 DO EN^VALM("BDG A&D DETAILED")
+5 DO CLEAR^VALM1
+6 QUIT
+7 ;
HDR ; -- header code
+1 SET VALMHDR(1)=$$SP(15)_$$CONF^BDGF
+2 SET X="ADMISSIONS & DISCHARGES for "_$$GET1^DIQ(4,DUZ(2),.01)
+3 SET VALMHDR(2)=$$SP(79-$LENGTH(X)\2)_X
+4 SET VALMHDR(3)=$$SP(12)="For "_$$DOW^XLFDT(BDGT)_" "_$$FMTE^XLFDT(BDGT,2)
+5 QUIT
+6 ;
INIT ; -- init variables and list array
+1 NEW SRV,PREV,SRVN,TOT,TOT1,TOT2
+2 KILL ^TMP("BDGADD",$JOB)
+3 SET VALMCNT=0
+4 ;previous date
SET PREV=$$FMADD^XLFDT(BDGT,-1)
+5 ;initialize totals
SET (TOT1,TOT2)=0
FOR I="O","I","N","D"
SET TOT(I)=""
+6 ;
+7 ;display total patients remaining at end of day
DO REMAIN
+8 ;display column headings
DO HDG
+9 ;display patients
DO PATDATA^BDGADD1
+10 ;
+11 QUIT
+12 ;
+13 ;
SET(DATA,NUM) ; put display line into array
+1 SET NUM=NUM+1
+2 SET ^TMP("BDGADD",$JOB,NUM,0)=DATA
+3 QUIT
+4 ;
REMAIN ; total up patients remaining at end of day
+1 ; count by service to pull out newborns and oberservations
+2 NEW COUNT,I,SV,SNM,SUB,LINE,N
+3 FOR I="I","O","N","D"
SET COUNT(I)=0
+4 SET SV=0
FOR
SET SV=$ORDER(^BDGCTX(SV))
IF 'SV
QUIT
Begin DoDot:1
+5 SET N=$GET(^BDGCTX(SV,1,BDGT,0))
IF N=""
QUIT
+6 ;service name
SET SNM=$$GET1^DIQ(45.7,SV,.01)
+7 SET SUB=$SELECT(SNM="NEWBORN":"N",SNM["OBSERVATION":"O",SNM="DAY SURGERY":"D",1:"I")
+8 SET COUNT(SUB)=COUNT(SUB)+$PIECE(N,U,2)+$PIECE(N,U,12)
End DoDot:1
+9 ;
+10 SET LINE="Inpatients:"_COUNT("I")
+11 SET LINE=$$PAD(LINE,25)_"Observations: "_COUNT("O")
+12 ;ihs/cmi/maw 09/14/2011 patch 1013
SET LINE=$$PAD(LINE,55)_"Day Surgerys: "_COUNT("D")
+13 SET LINE=$$PAD(LINE,85)_"Newborns: "_COUNT("N")
+14 DO SET(LINE,.VALMCNT)
DO SET("",.VALMCNT)
+15 QUIT
+16 ;
HDG ; set up column headings
+1 NEW LINE
+2 ;
+3 ;IHS/ANMC/LJF 6/11/2002 added PCP so column headings must change
+4 ;changed 25 -> 27, 34 -> 35 (LJF7 6/11/2002)
+5 SET LINE=$$PAD($$PAD(" NAME",27)_" HRCN",35)_"AGE"
+6 ;changed 63 -> 58 (LJF7 6/11/2002)
+7 SET LINE=$$PAD($$PAD(LINE,40)_"COMMUNITY",58)_"WARD SERV"
+8 ;changed 80 -> 72 and added code (LJF7 6/11/2002)
+9 SET LINE=$$PAD($$PAD(LINE,72)_"PROVIDER",92)_"PRIM CARE PRV"
+10 ;IHS/ANMC/LJF 6/11/2002 end of mods
+11 ;
+12 DO SET(LINE,.VALMCNT)
DO SET($$REPEAT^XLFSTR("-",110),.VALMCNT)
+13 QUIT
+14 ;
PRINT ; print report to paper
+1 NEW BDGX,BDGLN,WARD
+2 USE IO
DO PHDG
+3 ;
+4 ; loop thru display array
+5 SET BDGX=0
FOR
SET BDGX=$ORDER(^TMP("BDGADD",$JOB,BDGX))
IF 'BDGX
QUIT
Begin DoDot:1
+6 ;I $Y>(IOSL-4) D PHDG ;IHS/ANMC/LJF 6/5/2002 form feed at bottom of page (LJF7 6/11/2002)
+7 ;IHS/ANMC/LJF 6/5/2002 form feed at bottom of page (LJF7 6/11/2002)
IF $Y>(IOSL-4)
WRITE @IOF
DO PHDG
+8 WRITE !,^TMP("BDGADD",$JOB,BDGX,0)
End DoDot:1
+9 DO ^%ZISC
DO EXIT
+10 QUIT
+11 ;
PHDG ; heading for paper report
+1 ;D HDR W @IOF ;IHS/ANMC/LJF 6/5/2002 no form feed at beginning (LJF7 6/11/2002)
+2 ;IHS/ANMC/LJF 6/5/2002 no form feed at beginning (LJF7 6/11/2002)
DO HDR
+3 FOR I=1:1
IF '$DATA(VALMHDR(I))
QUIT
WRITE !,VALMHDR(I)
+4 WRITE !,$$REPEAT^XLFSTR("=",80)
+5 QUIT
+6 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("BDGADD",$JOB)
KILL BDGREP
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
PAD(D,L) ;EP -- SUBRTN to pad length of data
+1 ; -- D=data L=length
+2 QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)
+3 ;
SP(N) ; -- SUBRTN to pad N number of spaces
+1 QUIT $$PAD(" ",N)
