BDGPCCE.m

BDGPCCE ; IHS/ANMC/LJF - CODE PCC H VISIT ; 

 ;;5.3;PIMS;**1010**;APR 26, 2002

 ;

 ;cmi/anch/maw 10/20/2008 PATCH 1010 changed export date field from .14 to 1106

 ;

ASK ; ask user to select patient and visit

 NEW DFN,VSTN,DATE,END,BDGA,COUNT,ARRAY

 S DFN=+$$READ^BDGF("PO^2:EMZQ","Select Patient") Q:DFN<1

 ;

 ; find all recent hospitalizations (last year)

 S DATE=0,END=9999999-($$FMADD^XLFDT(DT,-731))

 F  S DATE=$O(^AUPNVSIT("AAH",DFN,DATE)) Q:'DATE  Q:(DATE>END)  D

 . S VSTN=0

 . F  S VSTN=$O(^AUPNVSIT("AAH",DFN,DATE,VSTN)) Q:'VSTN  D

 .. Q:$$GET1^DIQ(9000010,VSTN,.11)="DELETED"     ;deleted visit

 .. Q:$$GET1^DIQ(9000010,VSTN,.06,"I")'=DUZ(2)   ;not this facility

 .. ;

 .. ; put into array with visit date and date exported

 .. S COUNT=$G(COUNT)+1

 .. S BDGA(COUNT)=VSTN_U_"Admitted on "_$$PAD($$GET1^DIQ(9000010,VSTN,.01),30)

 .. ;

 .. S X=$O(^AUPNVINP("AD",VSTN,0)) I 'X D   ;current inpatient

 ... S BDGA(COUNT)=BDGA(COUNT)_"Current Inpatient"

 .. ;

 .. ;S X=$$GET1^DIQ(9000010,VSTN,.14)          ;date exported cmi/maw 10/20/2008 PATCH 1010 orig line

 .. S X=$$GET1^DIQ(9000010,VSTN,1106)          ;date exported cmi/maw 10/20/2008 PATCH 1010 new export date

 .. I X]"" S BDGA(COUNT)=BDGA(COUNT)_"Exported on "_X

 ;

 I '$D(BDGA) W !!,"No admissions on file for the past 2 years." D ASK Q

 ;I '$D(BDGA(2)),$P(BDGA(1),U,2)="" S BDGV=+BDGA(1) D BDGPCCEL Q

 ;

 ; else show user list for choosing

 W !!,"Select from these recent admissions:"

 F COUNT=1:1 Q:'$D(BDGA(COUNT))  D

 . S ARRAY(COUNT)=$J(COUNT,3)_". "_$P(BDGA(COUNT),U,2)

 S Y=$$READ^BDGF("N^1:"_(COUNT-1),"Select Hospitalization",1,,,.ARRAY)

 I Y<1 D ASK Q

 S BDGV=+BDGA(Y) D ^BDGPCCEL Q

 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)

BDGPCCE   ; IHS/ANMC/LJF - CODE PCC H VISIT ; 

 +1       ;;5.3;PIMS;**1010**;APR 26, 2002

 +2       ;

 +3       ;cmi/anch/maw 10/20/2008 PATCH 1010 changed export date field from .14 to 1106

 +4       ;

ASK       ; ask user to select patient and visit

 +1        NEW DFN,VSTN,DATE,END,BDGA,COUNT,ARRAY

 +2        SET DFN=+$$READ^BDGF("PO^2:EMZQ","Select Patient")

           IF DFN<1

               QUIT 

 +3       ;

 +4       ; find all recent hospitalizations (last year)

 +5        SET DATE=0

           SET END=9999999-($$FMADD^XLFDT(DT,-731))

 +6        FOR 

               SET DATE=$ORDER(^AUPNVSIT("AAH",DFN,DATE))

               IF 'DATE

                   QUIT 

               IF (DATE>END)

                   QUIT 

               Begin DoDot:1

 +7                SET VSTN=0

 +8                FOR 

                       SET VSTN=$ORDER(^AUPNVSIT("AAH",DFN,DATE,VSTN))

                       IF 'VSTN

                           QUIT 

                       Begin DoDot:2

 +9       ;deleted visit

                           IF $$GET1^DIQ(9000010,VSTN,.11)="DELETED"

                               QUIT 

 +10      ;not this facility

                           IF $$GET1^DIQ(9000010,VSTN,.06,"I")'=DUZ(2)

                               QUIT 

 +11      ;

 +12      ; put into array with visit date and date exported

 +13                       SET COUNT=$GET(COUNT)+1

 +14                       SET BDGA(COUNT)=VSTN_U_"Admitted on "_$$PAD($$GET1^DIQ(9000010,VSTN,.01),30)

 +15      ;

 +16      ;current inpatient

                           SET X=$ORDER(^AUPNVINP("AD",VSTN,0))

                           IF 'X

                               Begin DoDot:3

 +17                               SET BDGA(COUNT)=BDGA(COUNT)_"Current Inpatient"

                               End DoDot:3

 +18      ;

 +19      ;S X=$$GET1^DIQ(9000010,VSTN,.14)          ;date exported cmi/maw 10/20/2008 PATCH 1010 orig line

 +20      ;date exported cmi/maw 10/20/2008 PATCH 1010 new export date

                           SET X=$$GET1^DIQ(9000010,VSTN,1106)

 +21                       IF X]""

                               SET BDGA(COUNT)=BDGA(COUNT)_"Exported on "_X

                       End DoDot:2

               End DoDot:1

 +22      ;

 +23       IF '$DATA(BDGA)

               WRITE !!,"No admissions on file for the past 2 years."

               DO ASK

               QUIT 

 +24      ;I '$D(BDGA(2)),$P(BDGA(1),U,2)="" S BDGV=+BDGA(1) D BDGPCCEL Q

 +25      ;

 +26      ; else show user list for choosing

 +27       WRITE !!,"Select from these recent admissions:"

 +28       FOR COUNT=1:1

               IF '$DATA(BDGA(COUNT))

                   QUIT 

               Begin DoDot:1

 +29               SET ARRAY(COUNT)=$JUSTIFY(COUNT,3)_". "_$PIECE(BDGA(COUNT),U,2)

               End DoDot:1

 +30       SET Y=$$READ^BDGF("N^1:"_(COUNT-1),"Select Hospitalization",1,,,.ARRAY)

 +31       IF Y<1

               DO ASK

               QUIT 

 +32       SET BDGV=+BDGA(Y)

           DO ^BDGPCCEL

           QUIT 

 +33       QUIT 

 +34      ;

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)