BDGADD1 ; IHS/ANMC/LJF - A&D DETAILED PRINT CONT. ; [ 07/01/2002 10:18 AM ]
;;5.3;PIMS;**1003,1013**;MAY 28, 2004
;IHS/ITSC/LJF 6/2/2005 PATCH 1003 adjusted code under Deaths to match other sections
; added code for mulitple admits and discharges
;ihs/cmi/maw 9/14/2011 PATCH 1013 added day surgery
;
PATDATA ;EP; build display lines for patient data
; called by INIT^BDGADD
;
D ADMITS,DEATHS,TRANSFER
D ^BDGADD2 ;day surgery listing
Q
;
ADMITS ; build array of admits
; first for inpatients, then observations, then newborns
NEW SUB,SUB2,TITLE,TITLE2,X,NAME,DFN,IFN,LINE,DATA
F SUB="ADMIT","DSCH" D
. F SUB2="I","O","N","D" D
.. ;
.. ; display total admissions for category
.. S TITLE=$S(SUB2="I":"Inpatient",SUB2="O":"Observation",SUB2="D":"Day Surgery",1:"Newborn")
.. S TITLE2=$S(SUB="ADMIT":" Admissions:",1:" Discharges:")
.. S X=$$COUNT(SUB,SUB2) I X>0 D SET("",.VALMCNT),SET($$PAD(TITLE_TITLE2,25)_X,.VALMCNT)
.. ;
.. ; loop through admits
.. 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
.... ;
.... ;IHS/ITSC/LJF 6/3/2005 PATCH 1003 add extra loop using IFN
.... ;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 . to lines below
..... S LINE=$E($$GET1^DIQ(2,DFN,.01),1,25)
..... S LINE=$$PAD(LINE,27)_$J($$HRCN^BDGF2(DFN,DUZ(2)),6) ;chart
..... S LINE=$$PAD(LINE,35)_$P(DATA,U,4) ;age
..... S LINE=$$PAD(LINE,40)_$E($$GET1^DIQ(9000001,DFN,1118),1,15) ;community
..... S LINE=$$PAD(LINE,58)_$$GET1^DIQ(9009016.5,+$P(DATA,U,2),.02) ;ward
..... S LINE=$$PAD(LINE,65)_$$GET1^DIQ(45.7,+$P(DATA,U),99) ;service
..... S LINE=$$PAD(LINE,72)_$E($P(DATA,U,3),1,18) ;provider
..... K BDGX S BDGX="BDGX" D PCP^BSDU1(DFN,.BDGX) ;pcp
..... S LINE=$$PAD(LINE,92)_$E($P($G(BDGX(1)),"/"),1,18)
..... ;
..... D SET(LINE,.VALMCNT)
;end of PATCH 1003 changes
;
Q
;
TRANSFER ; loop through transfers (ward and service)
NEW SUB,FILE,FIELD,TITLE,X,NAME,DFN,IFN,DATA
;
F SUB="WARD","SERV" D
. ;
. ;ward/service abreviations file/field pairs
. S FILE=$S(SUB="WARD":9009016.5,1:45.7),FIELD=$S(SUB="WARD":.02,1:99)
. ;
. ; display total transfers for category
. S TITLE=$S(SUB="WARD":"Ward",1:"Service")
. S X=$$COUNT2(SUB)
. I X>0 D SET("",.VALMCNT),SET(TITLE_" Transfers: "_X,.VALMCNT)
. ;
. 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=$$PAD($E(NAME,1,17),20) ;name
.... S LINE=LINE_$J($$HRCN^BDGF2(DFN,DUZ(2)),6) ;chart #
.... S LINE=$$PAD(LINE,30)_$$GET1^DIQ(FILE,+$P(DATA,U),FIELD)
.... S LINE=$$PAD(LINE,35)_"-> "_$$GET1^DIQ(FILE,$P(DATA,U,2),FIELD)
.... D SET(LINE,.VALMCNT)
Q
;
;
DEATHS ; Now display any deaths
; display total # of deaths first
NEW X,NAME,DFN,IFN,DATA,LINE
;
;S X=$$COUNT("DEATH","") I X>0 D SET($$PAD("Deaths:",25)_X,.VALMCNT)
S X=$$COUNT("DEATH","") I X>0 D SET("",.VALMCNT),SET($$PAD("Deaths:",25)_X,.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
.. ;
.. ;IHS/ITSC/LJF 6/2/2005 PATCH 1003 changed columns around to match other sections
.. S DATA=^TMP("BDGAD",$J,"DEATH",NAME,DFN)
.. S LINE=$$PAD($E($$GET1^DIQ(2,DFN,.01),1,17),25) ;name
.. S LINE=$$PAD(LINE,27)_$J($$HRCN^BDGF2(DFN,DUZ(2)),6) ;chart#
.. S LINE=$$PAD(LINE,35)_$P(DATA,U,4) ;age
.. S LINE=$$PAD(LINE,40)_$E($$GET1^DIQ(9000001,DFN,1118),1,20) ;com
.. S LINE=$$PAD(LINE,58)_$$GET1^DIQ(9009016.5,+$P(DATA,U,2),.02) ;wd
.. ;S LINE=$$PAD(LINE,70)_$$GET1^DIQ(45.7,+$P(DATA,U,2),99) ;srv
.. S LINE=$$PAD(LINE,65)_$$GET1^DIQ(45.7,+$P(DATA,U),99) ;srv; PATCH 1003 fixed code
.. S LINE=$$PAD(LINE,72)_$E($P(DATA,U,3),1,20) ;prov
.. ; PATCH 1003 - 2 new lines
.. K BDGX S BDGX="BDGX" D PCP^BSDU1(DFN,.BDGX) ;pcp
.. S LINE=$$PAD(LINE,92)_$E($P($G(BDGX(1)),"/"),1,18)
.. ;
.. D SET(LINE,.VALMCNT)
Q
;
COUNT(X,X1) ; returns # of events based on type sent in X and X1
; X can = "ADMIT" or "DSCH" or "DEATH"
; X1 can = "O" or "I" or "N" or "" if X="DEATH"
;
NEW PIECE,SV,N,COUNT,SNM
S PIECE=$S(X="ADMIT":3,X="DSCH":4,1:7) ;piece in ^BDGCTX node
S SV=0 F S SV=$O(^BDGCTX(SV)) Q:'SV D
. S SNM=$$GET1^DIQ(45.7,SV,.01)
. I X'="DEATH",X1="I" Q:SNM="NEWBORN" Q:SNM["OBSERVATION" Q:SNM="DAY SURGERY"
. I X'="DEATH",X1="O" Q:SNM'["OBSERVATION"
. I X'="DEATH",X1="N" Q:SNM'="NEWBORN"
. I X'="DEATH",X1="D" Q:SNM'="DAY SURGERY"
. ;
. S N=$G(^BDGCTX(SV,1,BDGT,0))
. S COUNT=$G(COUNT)+$P(N,U,PIECE)+$P(N,U,PIECE+10)
Q +$G(COUNT)
;
COUNT2(X) ; returns # of events based on type sent in X and X1
; X can = "WARD" or "SERV"
;
NEW GBL,SV,N,COUNT
S GBL=$S(X="WARD":"^BDGCWD",1:"^BDGCTX")
S SV=0 F S SV=$O(@GBL@(SV)) Q:'SV D
. S N=$G(@GBL@(SV,1,BDGT,0))
. S COUNT=$G(COUNT)+$P(N,U,5)+$P(N,U,15)
Q +$G(COUNT)
;
SET(LINE,NUM) ; put display line into array
D SET^BDGADD(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)
BDGADD1 ; IHS/ANMC/LJF - A&D DETAILED PRINT CONT. ; [ 07/01/2002 10:18 AM ]
+1 ;;5.3;PIMS;**1003,1013**;MAY 28, 2004
+2 ;IHS/ITSC/LJF 6/2/2005 PATCH 1003 adjusted code under Deaths to match other sections
+3 ; added code for mulitple admits and discharges
+4 ;ihs/cmi/maw 9/14/2011 PATCH 1013 added day surgery
+5 ;
PATDATA ;EP; build display lines for patient data
+1 ; called by INIT^BDGADD
+2 ;
+3 DO ADMITS
DO DEATHS
DO TRANSFER
+4 ;day surgery listing
DO ^BDGADD2
+5 QUIT
+6 ;
ADMITS ; build array of admits
+1 ; first for inpatients, then observations, then newborns
+2 NEW SUB,SUB2,TITLE,TITLE2,X,NAME,DFN,IFN,LINE,DATA
+3 FOR SUB="ADMIT","DSCH"
Begin DoDot:1
+4 FOR SUB2="I","O","N","D"
Begin DoDot:2
+5 ;
+6 ; display total admissions for category
+7 SET TITLE=$SELECT(SUB2="I":"Inpatient",SUB2="O":"Observation",SUB2="D":"Day Surgery",1:"Newborn")
+8 SET TITLE2=$SELECT(SUB="ADMIT":" Admissions:",1:" Discharges:")
+9 SET X=$$COUNT(SUB,SUB2)
IF X>0
DO SET("",.VALMCNT)
DO SET($$PAD(TITLE_TITLE2,25)_X,.VALMCNT)
+10 ;
+11 ; loop through admits
+12 SET NAME=0
FOR
SET NAME=$ORDER(^TMP("BDGAD",$JOB,SUB,SUB2,NAME))
IF NAME=""
QUIT
Begin DoDot:3
+13 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("BDGAD",$JOB,SUB,SUB2,NAME,DFN))
IF 'DFN
QUIT
Begin DoDot:4
+14 ;
+15 ;IHS/ITSC/LJF 6/3/2005 PATCH 1003 add extra loop using IFN
+16 ;S DATA=^TMP("BDGAD",$J,SUB,SUB2,NAME,DFN)
+17 SET IFN=0
FOR
SET IFN=$ORDER(^TMP("BDGAD",$JOB,SUB,SUB2,NAME,DFN,IFN))
IF 'IFN
QUIT
Begin DoDot:5
+18 SET DATA=^TMP("BDGAD",$JOB,SUB,SUB2,NAME,DFN,IFN)
+19 ;
+20 ; PATCH 1003 added extra . to lines below
+21 SET LINE=$EXTRACT($$GET1^DIQ(2,DFN,.01),1,25)
+22 ;chart
SET LINE=$$PAD(LINE,27)_$JUSTIFY($$HRCN^BDGF2(DFN,DUZ(2)),6)
+23 ;age
SET LINE=$$PAD(LINE,35)_$PIECE(DATA,U,4)
+24 ;community
SET LINE=$$PAD(LINE,40)_$EXTRACT($$GET1^DIQ(9000001,DFN,1118),1,15)
+25 ;ward
SET LINE=$$PAD(LINE,58)_$$GET1^DIQ(9009016.5,+$PIECE(DATA,U,2),.02)
+26 ;service
SET LINE=$$PAD(LINE,65)_$$GET1^DIQ(45.7,+$PIECE(DATA,U),99)
+27 ;provider
SET LINE=$$PAD(LINE,72)_$EXTRACT($PIECE(DATA,U,3),1,18)
+28 ;pcp
KILL BDGX
SET BDGX="BDGX"
DO PCP^BSDU1(DFN,.BDGX)
+29 SET LINE=$$PAD(LINE,92)_$EXTRACT($PIECE($GET(BDGX(1)),"/"),1,18)
+30 ;
+31 DO SET(LINE,.VALMCNT)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+32 ;end of PATCH 1003 changes
+33 ;
+34 QUIT
+35 ;
TRANSFER ; loop through transfers (ward and service)
+1 NEW SUB,FILE,FIELD,TITLE,X,NAME,DFN,IFN,DATA
+2 ;
+3 FOR SUB="WARD","SERV"
Begin DoDot:1
+4 ;
+5 ;ward/service abreviations file/field pairs
+6 SET FILE=$SELECT(SUB="WARD":9009016.5,1:45.7)
SET FIELD=$SELECT(SUB="WARD":.02,1:99)
+7 ;
+8 ; display total transfers for category
+9 SET TITLE=$SELECT(SUB="WARD":"Ward",1:"Service")
+10 SET X=$$COUNT2(SUB)
+11 IF X>0
DO SET("",.VALMCNT)
DO SET(TITLE_" Transfers: "_X,.VALMCNT)
+12 ;
+13 SET NAME=0
FOR
SET NAME=$ORDER(^TMP("BDGAD",$JOB,SUB,NAME))
IF NAME=""
QUIT
Begin DoDot:2
+14 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("BDGAD",$JOB,SUB,NAME,DFN))
IF 'DFN
QUIT
Begin DoDot:3
+15 SET IFN=0
FOR
SET IFN=$ORDER(^TMP("BDGAD",$JOB,SUB,NAME,DFN,IFN))
IF 'IFN
QUIT
Begin DoDot:4
+16 ;
+17 SET DATA=^TMP("BDGAD",$JOB,SUB,NAME,DFN,IFN)
+18 ; old ward/srv -> new ward/srv
+19 ;name
SET LINE=$$PAD($EXTRACT(NAME,1,17),20)
+20 ;chart #
SET LINE=LINE_$JUSTIFY($$HRCN^BDGF2(DFN,DUZ(2)),6)
+21 SET LINE=$$PAD(LINE,30)_$$GET1^DIQ(FILE,+$PIECE(DATA,U),FIELD)
+22 SET LINE=$$PAD(LINE,35)_"-> "_$$GET1^DIQ(FILE,$PIECE(DATA,U,2),FIELD)
+23 DO SET(LINE,.VALMCNT)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
+26 ;
DEATHS ; Now display any deaths
+1 ; display total # of deaths first
+2 NEW X,NAME,DFN,IFN,DATA,LINE
+3 ;
+4 ;S X=$$COUNT("DEATH","") I X>0 D SET($$PAD("Deaths:",25)_X,.VALMCNT)
+5 SET X=$$COUNT("DEATH","")
IF X>0
DO SET("",.VALMCNT)
DO SET($$PAD("Deaths:",25)_X,.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 ;IHS/ITSC/LJF 6/2/2005 PATCH 1003 changed columns around to match other sections
+11 SET DATA=^TMP("BDGAD",$JOB,"DEATH",NAME,DFN)
+12 ;name
SET LINE=$$PAD($EXTRACT($$GET1^DIQ(2,DFN,.01),1,17),25)
+13 ;chart#
SET LINE=$$PAD(LINE,27)_$JUSTIFY($$HRCN^BDGF2(DFN,DUZ(2)),6)
+14 ;age
SET LINE=$$PAD(LINE,35)_$PIECE(DATA,U,4)
+15 ;com
SET LINE=$$PAD(LINE,40)_$EXTRACT($$GET1^DIQ(9000001,DFN,1118),1,20)
+16 ;wd
SET LINE=$$PAD(LINE,58)_$$GET1^DIQ(9009016.5,+$PIECE(DATA,U,2),.02)
+17 ;S LINE=$$PAD(LINE,70)_$$GET1^DIQ(45.7,+$P(DATA,U,2),99) ;srv
+18 ;srv; PATCH 1003 fixed code
SET LINE=$$PAD(LINE,65)_$$GET1^DIQ(45.7,+$PIECE(DATA,U),99)
+19 ;prov
SET LINE=$$PAD(LINE,72)_$EXTRACT($PIECE(DATA,U,3),1,20)
+20 ; PATCH 1003 - 2 new lines
+21 ;pcp
KILL BDGX
SET BDGX="BDGX"
DO PCP^BSDU1(DFN,.BDGX)
+22 SET LINE=$$PAD(LINE,92)_$EXTRACT($PIECE($GET(BDGX(1)),"/"),1,18)
+23 ;
+24 DO SET(LINE,.VALMCNT)
End DoDot:2
End DoDot:1
+25 QUIT
+26 ;
COUNT(X,X1) ; returns # of events based on type sent in X and X1
+1 ; X can = "ADMIT" or "DSCH" or "DEATH"
+2 ; X1 can = "O" or "I" or "N" or "" if X="DEATH"
+3 ;
+4 NEW PIECE,SV,N,COUNT,SNM
+5 ;piece in ^BDGCTX node
SET PIECE=$SELECT(X="ADMIT":3,X="DSCH":4,1:7)
+6 SET SV=0
FOR
SET SV=$ORDER(^BDGCTX(SV))
IF 'SV
QUIT
Begin DoDot:1
+7 SET SNM=$$GET1^DIQ(45.7,SV,.01)
+8 IF X'="DEATH"
IF X1="I"
IF SNM="NEWBORN"
QUIT
IF SNM["OBSERVATION"
QUIT
IF SNM="DAY SURGERY"
QUIT
+9 IF X'="DEATH"
IF X1="O"
IF SNM'["OBSERVATION"
QUIT
+10 IF X'="DEATH"
IF X1="N"
IF SNM'="NEWBORN"
QUIT
+11 IF X'="DEATH"
IF X1="D"
IF SNM'="DAY SURGERY"
QUIT
+12 ;
+13 SET N=$GET(^BDGCTX(SV,1,BDGT,0))
+14 SET COUNT=$GET(COUNT)+$PIECE(N,U,PIECE)+$PIECE(N,U,PIECE+10)
End DoDot:1
+15 QUIT +$GET(COUNT)
+16 ;
COUNT2(X) ; returns # of events based on type sent in X and X1
+1 ; X can = "WARD" or "SERV"
+2 ;
+3 NEW GBL,SV,N,COUNT
+4 SET GBL=$SELECT(X="WARD":"^BDGCWD",1:"^BDGCTX")
+5 SET SV=0
FOR
SET SV=$ORDER(@GBL@(SV))
IF 'SV
QUIT
Begin DoDot:1
+6 SET N=$GET(@GBL@(SV,1,BDGT,0))
+7 SET COUNT=$GET(COUNT)+$PIECE(N,U,5)+$PIECE(N,U,15)
End DoDot:1
+8 QUIT +$GET(COUNT)
+9 ;
SET(LINE,NUM) ; put display line into array
+1 DO SET^BDGADD(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)
