- 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)
