Routine: BSDHSP

BSDHSP ; IHS/ANMC/LJF - PRINT/BROWSE HEALTH SUMMARY ;  [ 02/10/2005  4:07 PM ]

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

 I $T(EN^APCHS)="" W !!,"HEALTH SUMMARY PACKAGE NOT INSTALLED." D PAUSE^BDGF Q

 NEW DFN,APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY

 S DFN=$G(SDFN)

 I '$D(SDFN) S DFN=+$$READ^BDGF("P^2:EMQZ","Select Patient")

 Q:'DFN  S APCHSPAT=DFN

 D GETHSTYP Q:'$G(APCHSTYP)   ;ask health summary type

 ;IHS/ITSC/WAR 2/2/2005 PATCH #1002 SPT issue dealing with HS

 S BSDSPT=$O(^DGSL(38.1,DFN,"D",0))

 I BSDSPT>0 D

 .I $P(^DGSL(38.1,DFN,"D",BSDSPT,0),U,3)["Appointment Management" D

 ..S $P(^DGSL(38.1,DFN,"D",BSDSPT,0),U,3)="AM/Health Summary"

 I $$BROWSE^BDGF="B" D EN Q   ;view in browse mode

 ;IHS/ITSC/WAR 2/2/2005 PATCH #1002 SPT issue dealing with HS

 ;  If they didn't browse (D EN, from above) then they printed it.

 I BSDSPT>0 S $P(^DGSL(38.1,DFN,"D",BSDSPT,0),U,3)="AM/PrtHealth Summary"

 D ZIS^BDGF("PQ","EN^APCHS","HEALTH SUMMARY","APCHSPAT;APCHSTYP") Q

EN ;EP; -- main entry point for list template BSDAM HS VIEW

 NEW VALMCNT D TERM^VALM0,CLEAR^VALM1

 D EN^VALM("BSDAM HS VIEW")

 D CLEAR^VALM1

HDR ;EP; -- header code

INIT ;EP; -- init variables and list array

 NEW X S VALMCNT=0

 K ^TMP("BSDHSP",$J),^TMP("BSDHSP1",$J)

 D GUIR^XBLM("EN^APCHS","^TMP(""BSDHSP1"",$J,")

 S X=0 F  S X=$O(^TMP("BSDHSP1",$J,X)) Q:'X  D

 . S VALMCNT=X

 . S ^TMP("BSDHSP",$J,X,0)=^TMP("BSDHSP1",$J,X)

 K ^TMP("BSDHSP1",$J)

HELP ;EP; -- help code

 S X="?" D DISP^XQORM1 W !!

EXIT ;EP; -- exit code

 K ^TMP("BSDHSP",$J)

EXPND ;EP; -- expand code

GETHSTYP ; -- ask user for health summary type

 NEW DIC,X,Y

 S DIC="^APCHSCTL(",DIC(0)="AEMQ"

 ; try to determine a default for question

 ;   first based on current clinic

 S X=$$GET1^DIQ(9009017.2,+$G(SDCLN),.05)

 ;   next based on last one used by user

 I X="",$D(^DISV(DUZ,"^APCHSCTL(")) D

 . S Y=^("^APCHSCTL(") I $D(^APCHSCTL(Y,0)) S X=$P(^(0),U,1)

 ;   last find default for whole facility

 I X="",$D(^APCCCTRL(+$G(DUZ(2)),0)) S X=$$GET1^DIQ(9001000,DUZ(2),.03)

 S:X="" X="ADULT REGULAR" S DIC("B")=X

 D ^DIC K DIC Q:Y<1  S APCHSTYP=+Y

BSDHSP    ; IHS/ANMC/LJF - PRINT/BROWSE HEALTH SUMMARY ;  [ 02/10/2005  4:07 PM ]

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

 +2       ;

 +3        IF $TEXT(EN^APCHS)=""

               WRITE !!,"HEALTH SUMMARY PACKAGE NOT INSTALLED."

               DO PAUSE^BDGF

               QUIT

 +4       ;

 +5        NEW DFN,APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY

 +6        SET DFN=$GET(SDFN)

 +7        IF '$DATA(SDFN)

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

 +8        IF 'DFN

               QUIT

           SET APCHSPAT=DFN

 +9       ;

 +10      ;ask health summary type

           DO GETHSTYP

           IF '$GET(APCHSTYP)

               QUIT

 +11      ;IHS/ITSC/WAR 2/2/2005 PATCH #1002 SPT issue dealing with HS

 +12       SET BSDSPT=$ORDER(^DGSL(38.1,DFN,"D",0))

 +13       IF BSDSPT>0

               Begin DoDot:1

 +14               IF $PIECE(^DGSL(38.1,DFN,"D",BSDSPT,0),U,3)["Appointment Management"

                       Begin DoDot:2

 +15                       SET $PIECE(^DGSL(38.1,DFN,"D",BSDSPT,0),U,3)="AM/Health Summary"

                       End DoDot:2

               End DoDot:1

 +16      ;

 +17      ;view in browse mode

           IF $$BROWSE^BDGF="B"

               DO EN

               QUIT

 +18      ;IHS/ITSC/WAR 2/2/2005 PATCH #1002 SPT issue dealing with HS

 +19      ;  If they didn't browse (D EN, from above) then they printed it.

 +20       IF BSDSPT>0

               SET $PIECE(^DGSL(38.1,DFN,"D",BSDSPT,0),U,3)="AM/PrtHealth Summary"

 +21       DO ZIS^BDGF("PQ","EN^APCHS","HEALTH SUMMARY","APCHSPAT;APCHSTYP")

           QUIT

 +22      ;

 +23      ;

EN        ;EP; -- main entry point for list template BSDAM HS VIEW

 +1        NEW VALMCNT

           DO TERM^VALM0

           DO CLEAR^VALM1

 +2        DO EN^VALM("BSDAM HS VIEW")

 +3        DO CLEAR^VALM1

 +4        QUIT

 +5       ;

HDR       ;EP; -- header code

 +1        QUIT

 +2       ;

INIT      ;EP; -- init variables and list array

 +1        NEW X

           SET VALMCNT=0

 +2        KILL ^TMP("BSDHSP",$JOB),^TMP("BSDHSP1",$JOB)

 +3        DO GUIR^XBLM("EN^APCHS","^TMP(""BSDHSP1"",$J,")

 +4        SET X=0

FOR

               SET X=$ORDER(^TMP("BSDHSP1",$JOB,X))

               IF 'X

                   QUIT

               Begin DoDot:1

 +5                SET VALMCNT=X

 +6                SET ^TMP("BSDHSP",$JOB,X,0)=^TMP("BSDHSP1",$JOB,X)

               End DoDot:1

 +7        KILL ^TMP("BSDHSP1",$JOB)

 +8        QUIT

 +9       ;

HELP      ;EP; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT

 +3       ;

EXIT      ;EP; -- exit code

 +1        KILL ^TMP("BSDHSP",$JOB)

 +2        QUIT

 +3       ;

EXPND     ;EP; -- expand code

 +1        QUIT

 +2       ;

GETHSTYP  ; -- ask user for health summary type

 +1        NEW DIC,X,Y

 +2        SET DIC="^APCHSCTL("

           SET DIC(0)="AEMQ"

 +3       ;

 +4       ; try to determine a default for question

 +5       ;   first based on current clinic

 +6        SET X=$$GET1^DIQ(9009017.2,+$GET(SDCLN),.05)

 +7       ;   next based on last one used by user

 +8        IF X=""

               IF $DATA(^DISV(DUZ,"^APCHSCTL("))

                   Begin DoDot:1

 +9                    SET Y=^("^APCHSCTL(")

                       IF $DATA(^APCHSCTL(Y,0))

                           SET X=$PIECE(^(0),U,1)

                   End DoDot:1

 +10      ;   last find default for whole facility

 +11       IF X=""

               IF $DATA(^APCCCTRL(+$GET(DUZ(2)),0))

                   SET X=$$GET1^DIQ(9001000,DUZ(2),.03)

 +12       IF X=""

               SET X="ADULT REGULAR"

           SET DIC("B")=X

 +13       DO ^DIC

           KILL DIC

           IF Y<1

               QUIT

           SET APCHSTYP=+Y

 +14       QUIT

BSDHSP.m