BDGADS1 ; IHS/ANMC/LJF - A&D SUMMARY PRINT CONT. ;
;;5.3;PIMS;**1003,1013**;MAY 28, 2004
;IHS/ITSC/LJF 6/3/2005 PATCH 1003 added code for multiple admits or discharges
;
PATDATA ;EP; build display lines for patient data
; called by INIT^BDGADS
;
D ADMITS,TRANSFER,DEATHS
D ^BDGADS2 ;day surgery listing
Q
;
ADMITS ; build array of admits and discharges
NEW SUB2,X,LINE
I '$D(^TMP("BDGAD",$J,"ADMIT")),'$D(^TMP("BDGAD",$J,"DSCH")) Q
; first for inpatients, then observations, then newborns
F SUB2="I","O","N","D" D
. ;
. I '$D(^TMP("BDGAD",$J,"ADMIT",SUB2)),'$D(^TMP("BDGAD",$J,"DSCH",SUB2)) Q
. ;
. ; print heading
. S X=$S(SUB2="I":"Inpatient",SUB2="O":"Observation",SUB2="D":"Day Surgery",1:"Newborn")
. S LINE=$$PAD($$SP(5)_X_" Admissions",45)_X_" Discharges"
. D SET(LINE,.VALMCNT)
. S LINE=$$PAD($$REPEAT^XLFSTR("-",36),40)_$$REPEAT^XLFSTR("-",36)
. D SET(LINE,.VALMCNT)
. ;
. ;
. ;IHS/ITSC/LJF 6/3/2005 PATCH 1003 rewrote this section to add extra loop using IFN
. ; loop through admits, then discharges to set up 2 columns
. NEW ADMIT,DSCH,COUNT,NAME,DFN,DATA,IFN ;PATCH 1003 added IFN
. F SUB="ADMIT","DSCH" D
.. S COUNT=0
.. S NAME=0 F S NAME=$O(^TMP("BDGAD",$J,SUB,SUB2,NAME)) Q:NAME="" D
... S DFN=0 F S DFN=$O(^TMP("BDGAD",$J,SUB,SUB2,NAME,DFN)) Q:'DFN D
.... ;
.... ;S DATA=^TMP("BDGAD",$J,SUB,SUB2,NAME,DFN)
.... S IFN=0 F S IFN=$O(^TMP("BDGAD",$J,SUB,SUB2,NAME,DFN,IFN)) Q:'IFN D
..... S DATA=^TMP("BDGAD",$J,SUB,SUB2,NAME,DFN,IFN)
..... ;
..... ; PATCH 1003 added extra .
..... S LINE=$$GET1^DIQ(45.7,+$P(DATA,U),99) ;service abbrev
..... S LINE=$$PAD(LINE,6)_$$GET1^DIQ(9009016.5,$P(DATA,U,2),.02) ;ward
..... S LINE=$$PAD(LINE,12)_$J($$HRCN^BDGF2(DFN,DUZ(2)),6) ;chart #
..... S LINE=$$PAD(LINE,20)_$E(NAME,1,18) ;name
..... S COUNT=COUNT+1,@SUB@(COUNT)=LINE
. ;end of PATCH 1003 changes
. ;
. ; Then put both columns into display array
. F COUNT=1:1 Q:('$D(ADMIT(COUNT))&'$D(DSCH(COUNT))) D
. . S LINE=$$PAD($G(ADMIT(COUNT)),40)_$G(DSCH(COUNT))
.. D SET(LINE,.VALMCNT)
;
Q
;
TRANSFER ; loop through transfers (ward and service)
NEW LINE,WARD,SERV,COUNT,FILE,FIELD,NAME,DFN,IFN
I '$D(^TMP("BDGAD",$J,"WARD")),'$D(^TMP("BDGAD",$J,"SERV")) Q
;
; display headings
S LINE=$$PAD($$SP(5)_"Ward Transfers",45)_"Service Transfers"
D SET(LINE,.VALMCNT)
S LINE=$$PAD($$REPEAT^XLFSTR("-",36),40)_$$REPEAT^XLFSTR("-",36)
D SET(LINE,.VALMCNT)
;
F SUB="WARD","SERV" D
. S COUNT=0
. ;
. ;ward/service abreviations file/field pairs
. S FILE=$S(SUB="WARD":9009016.5,1:45.7),FIELD=$S(SUB="WARD":.02,1:99)
. ;
. S NAME=0 F S NAME=$O(^TMP("BDGAD",$J,SUB,NAME)) Q:NAME="" D
.. S DFN=0 F S DFN=$O(^TMP("BDGAD",$J,SUB,NAME,DFN)) Q:'DFN D
... S IFN=0 F S IFN=$O(^TMP("BDGAD",$J,SUB,NAME,DFN,IFN)) Q:'IFN D
.... ;
.... S DATA=^TMP("BDGAD",$J,SUB,NAME,DFN,IFN)
.... ; old ward/srv -> new ward/srv
.... S LINE=$$GET1^DIQ(FILE,+$P(DATA,U),FIELD)
.... S LINE=$$PAD(LINE,5)_"-> "_$$GET1^DIQ(FILE,$P(DATA,U,2),FIELD)
.... S LINE=$$PAD(LINE,13)_$J($$HRCN^BDGF2(DFN,DUZ(2)),6) ;chart #
.... S LINE=$$PAD(LINE,21)_$E(NAME,1,17) ;name
.... S COUNT=COUNT+1,@SUB@(COUNT)=LINE
;
; Then put both columns into display array
F COUNT=1:1 Q:'$D(WARD(COUNT))&'$D(SERV(COUNT)) D
. S LINE=$$PAD($G(WARD(COUNT)),40)_$G(SERV(COUNT))
. D SET(LINE,.VALMCNT)
Q
;
;
DEATHS ; Now display any deaths
NEW NAME,DFN,DATA,LINE
Q:'$D(^TMP("BDGAD",$J,"DEATH"))
;
D SET($$SP(45)_"Deaths",.VALMCNT)
D SET($$SP(40)_$$REPEAT^XLFSTR("-",36),.VALMCNT)
;
S NAME=0 F S NAME=$O(^TMP("BDGAD",$J,"DEATH",NAME)) Q:NAME="" D
. S DFN=0 F S DFN=$O(^TMP("BDGAD",$J,"DEATH",NAME,DFN)) Q:'DFN D
.. ;
.. S DATA=^TMP("BDGAD",$J,"DEATH",NAME,DFN)
.. S LINE=$$SP(40)_$$GET1^DIQ(45.7,+DATA,99) ;sserv abbrev
.. S LINE=$$PAD(LINE,47)_$$GET1^DIQ(9009016.5,$P(DATA,U,2),.02) ;ward
.. S LINE=$$PAD(LINE,54)_$J($$HRCN^BDGF2(DFN,DUZ(2)),6) ;chart #
.. S LINE=$$PAD(LINE,62)_$E(NAME,1,17) ;name
.. D SET(LINE,.VALMCNT)
Q
;
SET(LINE,NUM) ; put display line into array
D SET^BDGADS(LINE,.NUM)
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)
BDGADS1 ; IHS/ANMC/LJF - A&D SUMMARY PRINT CONT. ;
+1 ;;5.3;PIMS;**1003,1013**;MAY 28, 2004
+2 ;IHS/ITSC/LJF 6/3/2005 PATCH 1003 added code for multiple admits or discharges
+3 ;
PATDATA ;EP; build display lines for patient data
+1 ; called by INIT^BDGADS
+2 ;
+3 DO ADMITS
DO TRANSFER
DO DEATHS
+4 ;day surgery listing
DO ^BDGADS2
+5 QUIT
+6 ;
ADMITS ; build array of admits and discharges
+1 NEW SUB2,X,LINE
+2 IF '$DATA(^TMP("BDGAD",$JOB,"ADMIT"))
IF '$DATA(^TMP("BDGAD",$JOB,"DSCH"))
QUIT
+3 ; first for inpatients, then observations, then newborns
+4 FOR SUB2="I","O","N","D"
Begin DoDot:1
+5 ;
+6 IF '$DATA(^TMP("BDGAD",$JOB,"ADMIT",SUB2))
IF '$DATA(^TMP("BDGAD",$JOB,"DSCH",SUB2))
QUIT
+7 ;
+8 ; print heading
+9 SET X=$SELECT(SUB2="I":"Inpatient",SUB2="O":"Observation",SUB2="D":"Day Surgery",1:"Newborn")
+10 SET LINE=$$PAD($$SP(5)_X_" Admissions",45)_X_" Discharges"
+11 DO SET(LINE,.VALMCNT)
+12 SET LINE=$$PAD($$REPEAT^XLFSTR("-",36),40)_$$REPEAT^XLFSTR("-",36)
+13 DO SET(LINE,.VALMCNT)
+14 ;
+15 ;
+16 ;IHS/ITSC/LJF 6/3/2005 PATCH 1003 rewrote this section to add extra loop using IFN
+17 ; loop through admits, then discharges to set up 2 columns
+18 ;PATCH 1003 added IFN
NEW ADMIT,DSCH,COUNT,NAME,DFN,DATA,IFN
+19 FOR SUB="ADMIT","DSCH"
Begin DoDot:2
+20 SET COUNT=0
+21 SET NAME=0
FOR
SET NAME=$ORDER(^TMP("BDGAD",$JOB,SUB,SUB2,NAME))
IF NAME=""
QUIT
Begin DoDot:3
+22 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("BDGAD",$JOB,SUB,SUB2,NAME,DFN))
IF 'DFN
QUIT
Begin DoDot:4
+23 ;
+24 ;S DATA=^TMP("BDGAD",$J,SUB,SUB2,NAME,DFN)
+25 SET IFN=0
FOR
SET IFN=$ORDER(^TMP("BDGAD",$JOB,SUB,SUB2,NAME,DFN,IFN))
IF 'IFN
QUIT
Begin DoDot:5
+26 SET DATA=^TMP("BDGAD",$JOB,SUB,SUB2,NAME,DFN,IFN)
+27 ;
+28 ; PATCH 1003 added extra .
+29 ;service abbrev
SET LINE=$$GET1^DIQ(45.7,+$PIECE(DATA,U),99)
+30 ;ward
SET LINE=$$PAD(LINE,6)_$$GET1^DIQ(9009016.5,$PIECE(DATA,U,2),.02)
+31 ;chart #
SET LINE=$$PAD(LINE,12)_$JUSTIFY($$HRCN^BDGF2(DFN,DUZ(2)),6)
+32 ;name
SET LINE=$$PAD(LINE,20)_$EXTRACT(NAME,1,18)
+33 SET COUNT=COUNT+1
SET @SUB@(COUNT)=LINE
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+34 ;end of PATCH 1003 changes
+35 ;
+36 ; Then put both columns into display array
+37 FOR COUNT=1:1
IF ('$DATA(ADMIT(COUNT))&'$DATA(DSCH(COUNT)))
QUIT
Begin DoDot:2
+38 SET LINE=$$PAD($GET(ADMIT(COUNT)),40)_$GET(DSCH(COUNT))
+39 DO SET(LINE,.VALMCNT)
End DoDot:2
End DoDot:1
+40 ;
+41 QUIT
+42 ;
TRANSFER ; loop through transfers (ward and service)
+1 NEW LINE,WARD,SERV,COUNT,FILE,FIELD,NAME,DFN,IFN
+2 IF '$DATA(^TMP("BDGAD",$JOB,"WARD"))
IF '$DATA(^TMP("BDGAD",$JOB,"SERV"))
QUIT
+3 ;
+4 ; display headings
+5 SET LINE=$$PAD($$SP(5)_"Ward Transfers",45)_"Service Transfers"
+6 DO SET(LINE,.VALMCNT)
+7 SET LINE=$$PAD($$REPEAT^XLFSTR("-",36),40)_$$REPEAT^XLFSTR("-",36)
+8 DO SET(LINE,.VALMCNT)
+9 ;
+10 FOR SUB="WARD","SERV"
Begin DoDot:1
+11 SET COUNT=0
+12 ;
+13 ;ward/service abreviations file/field pairs
+14 SET FILE=$SELECT(SUB="WARD":9009016.5,1:45.7)
SET FIELD=$SELECT(SUB="WARD":.02,1:99)
+15 ;
+16 SET NAME=0
FOR
SET NAME=$ORDER(^TMP("BDGAD",$JOB,SUB,NAME))
IF NAME=""
QUIT
Begin DoDot:2
+17 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("BDGAD",$JOB,SUB,NAME,DFN))
IF 'DFN
QUIT
Begin DoDot:3
+18 SET IFN=0
FOR
SET IFN=$ORDER(^TMP("BDGAD",$JOB,SUB,NAME,DFN,IFN))
IF 'IFN
QUIT
Begin DoDot:4
+19 ;
+20 SET DATA=^TMP("BDGAD",$JOB,SUB,NAME,DFN,IFN)
+21 ; old ward/srv -> new ward/srv
+22 SET LINE=$$GET1^DIQ(FILE,+$PIECE(DATA,U),FIELD)
+23 SET LINE=$$PAD(LINE,5)_"-> "_$$GET1^DIQ(FILE,$PIECE(DATA,U,2),FIELD)
+24 ;chart #
SET LINE=$$PAD(LINE,13)_$JUSTIFY($$HRCN^BDGF2(DFN,DUZ(2)),6)
+25 ;name
SET LINE=$$PAD(LINE,21)_$EXTRACT(NAME,1,17)
+26 SET COUNT=COUNT+1
SET @SUB@(COUNT)=LINE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+27 ;
+28 ; Then put both columns into display array
+29 FOR COUNT=1:1
IF '$DATA(WARD(COUNT))&'$DATA(SERV(COUNT))
QUIT
Begin DoDot:1
+30 SET LINE=$$PAD($GET(WARD(COUNT)),40)_$GET(SERV(COUNT))
+31 DO SET(LINE,.VALMCNT)
End DoDot:1
+32 QUIT
+33 ;
+34 ;
DEATHS ; Now display any deaths
+1 NEW NAME,DFN,DATA,LINE
+2 IF '$DATA(^TMP("BDGAD",$JOB,"DEATH"))
QUIT
+3 ;
+4 DO SET($$SP(45)_"Deaths",.VALMCNT)
+5 DO SET($$SP(40)_$$REPEAT^XLFSTR("-",36),.VALMCNT)
+6 ;
+7 SET NAME=0
FOR
SET NAME=$ORDER(^TMP("BDGAD",$JOB,"DEATH",NAME))
IF NAME=""
QUIT
Begin DoDot:1
+8 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("BDGAD",$JOB,"DEATH",NAME,DFN))
IF 'DFN
QUIT
Begin DoDot:2
+9 ;
+10 SET DATA=^TMP("BDGAD",$JOB,"DEATH",NAME,DFN)
+11 ;sserv abbrev
SET LINE=$$SP(40)_$$GET1^DIQ(45.7,+DATA,99)
+12 ;ward
SET LINE=$$PAD(LINE,47)_$$GET1^DIQ(9009016.5,$PIECE(DATA,U,2),.02)
+13 ;chart #
SET LINE=$$PAD(LINE,54)_$JUSTIFY($$HRCN^BDGF2(DFN,DUZ(2)),6)
+14 ;name
SET LINE=$$PAD(LINE,62)_$EXTRACT(NAME,1,17)
+15 DO SET(LINE,.VALMCNT)
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
SET(LINE,NUM) ; put display line into array
+1 DO SET^BDGADS(LINE,.NUM)
+2 QUIT
+3 ;
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)
