BIHS.m

BIHS ;IHS/CMI/MWR - DISPLAY HEALTH SUMMARY; MAY 10, 2010

 ;;8.5;IMMUNIZATION;;SEP 01,2011

 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *

 ;;  CALLS APCH SOFTWARE TO DISPLAY HEALTH SUMMARY.

 ;;  CALLED BY PROTOCOL: BI HEALTH SUMMARY.

 ;

 ;

 ;----------

HS ;EP

 ;---> Called from Protocol to display Health Summary.

 ;

 Q:'$G(BIDFN)

 N DFN,X,Y

 D FULL^VALM1

 ;

 ;---> Set Health Summary Type default.

 D

 .;---> Look for user's last choice.

 .N Y S Y=$G(^DISV($G(DUZ),"^APCHSCTL("))

 .S X=$P($G(^APCHSCTL(+Y,0)),U,1)

 .Q:X]""

 .;

 .;---> Get default from PCC MASTER CONTROL File.

 .I $D(^APCCCTRL($G(DUZ(2)),0))#2 S X=$P(^(0),U,3) Q

 .;

 .S X="ADULT REGULAR"

 ;

 ;---> Select Health Summary Type.

 D DIC^BIFMAN(9001015,"QEMA",.Y,,$G(X))

 Q:Y<0

 ;

 N APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY,AMCHDAYS,AMCHDOB,APCDHDR

 S APCHSTYP=+Y,(APCHSPAT,DFN)=BIDFN

 S APCDHDR="PCC Health Summary for "_$P(^DPT(DFN,0),U)

 D

 .;---> Preserve BIDFN.

 .N BIDFN

 .;---> Call Viewer.

 .D VIEWR^XBLM("EN^APCHS",APCDHDR)

 .;---> Use next line the instead of the previous if there are problems

 .;---> with Listmanager display of Health Summary.  ;MWRZZZ

 .;D HSOUT^APCHS,DIRZ^BIUTL3()

 ;

 Q

BIHS      ;IHS/CMI/MWR - DISPLAY HEALTH SUMMARY; MAY 10, 2010

 +1       ;;8.5;IMMUNIZATION;;SEP 01,2011

 +2       ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *

 +3       ;;  CALLS APCH SOFTWARE TO DISPLAY HEALTH SUMMARY.

 +4       ;;  CALLED BY PROTOCOL: BI HEALTH SUMMARY.

 +5       ;

 +6       ;

 +7       ;----------

HS        ;EP

 +1       ;---> Called from Protocol to display Health Summary.

 +2       ;

 +3        IF '$GET(BIDFN)

               QUIT 

 +4        NEW DFN,X,Y

 +5        DO FULL^VALM1

 +6       ;

 +7       ;---> Set Health Summary Type default.

 +8        Begin DoDot:1

 +9       ;---> Look for user's last choice.

 +10           NEW Y

               SET Y=$GET(^DISV($GET(DUZ),"^APCHSCTL("))

 +11           SET X=$PIECE($GET(^APCHSCTL(+Y,0)),U,1)

 +12           IF X]""

                   QUIT 

 +13      ;

 +14      ;---> Get default from PCC MASTER CONTROL File.

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

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

                   QUIT 

 +16      ;

 +17           SET X="ADULT REGULAR"

           End DoDot:1

 +18      ;

 +19      ;---> Select Health Summary Type.

 +20       DO DIC^BIFMAN(9001015,"QEMA",.Y,,$GET(X))

 +21       IF Y<0

               QUIT 

 +22      ;

 +23       NEW APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY,AMCHDAYS,AMCHDOB,APCDHDR

 +24       SET APCHSTYP=+Y

           SET (APCHSPAT,DFN)=BIDFN

 +25       SET APCDHDR="PCC Health Summary for "_$PIECE(^DPT(DFN,0),U)

 +26       Begin DoDot:1

 +27      ;---> Preserve BIDFN.

 +28           NEW BIDFN

 +29      ;---> Call Viewer.

 +30           DO VIEWR^XBLM("EN^APCHS",APCDHDR)

 +31      ;---> Use next line the instead of the previous if there are problems

 +32      ;---> with Listmanager display of Health Summary.  ;MWRZZZ

 +33      ;D HSOUT^APCHS,DIRZ^BIUTL3()

           End DoDot:1

 +34      ;

 +35       QUIT