BDGADS1.m

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)