BHSFLOA.m

BHSFLOA ;IHS/CIA/MGH - Health Summary for Flowsheets ;17-Mar-2006 10:36;MGH

 ;;1.0;HEALTH SUMMARY COMPONENTS;;March 17, 2006

 ;==================================================================

 ;Updated to use VA health summary

 ;Taken from APCHS12A

 ; IHS/TUCSON/LAB - PART 12A OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;

 ;;2.0;IHS RPMS/PCC Health Summary;;JUN 24, 1997

 ;====================================================================

 ; ********** FLOWSHEET PRODUCTION **********

FLOWD ;ENTRY POINT

 N X

 S X=-BHSIVD\1+9999999 D REGDT4^GMTSU S BHSDAT=X

 S BHSP="",$P(BHSP,"-",BHSMXL+9)="" D CKP^GMTSUP Q:$D(GMTSQIT)  W:'GMTSNPG ?2,BHSP,! D:GMTSNPG FLOWHD^BHSFLOW

 D FLOWCKP^BHSFLOW Q:$D(GMTSQIT)

 W ?2,BHSDAT

 F BHSI=0:0 S BHSI=$O(BHSDB(BHSI)) Q:'BHSI  D FLOWCKP^BHSFLOW Q:$D(GMTSQIT)  D FLOWD2 W !

 Q

FLOWD2 F BHSJ=0:0 S BHSJ=$O(BHSTB(BHSJ)) Q:'BHSJ  W ?12+BHSTB(BHSJ),":",$G(BHSDB(BHSI,BHSJ))

 Q

BHSFLOA   ;IHS/CIA/MGH - Health Summary for Flowsheets ;17-Mar-2006 10:36;MGH

 +1       ;;1.0;HEALTH SUMMARY COMPONENTS;;March 17, 2006

 +2       ;==================================================================

 +3       ;Updated to use VA health summary

 +4       ;Taken from APCHS12A

 +5       ; IHS/TUCSON/LAB - PART 12A OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;

 +6       ;;2.0;IHS RPMS/PCC Health Summary;;JUN 24, 1997

 +7       ;====================================================================

 +8       ; ********** FLOWSHEET PRODUCTION **********

FLOWD     ;ENTRY POINT

 +1        NEW X

 +2        SET X=-BHSIVD\1+9999999

           DO REGDT4^GMTSU

           SET BHSDAT=X

 +3        SET BHSP=""

           SET $PIECE(BHSP,"-",BHSMXL+9)=""

           DO CKP^GMTSUP

           IF $DATA(GMTSQIT)

               QUIT 

           IF 'GMTSNPG

               WRITE ?2,BHSP,!

           IF GMTSNPG

               DO FLOWHD^BHSFLOW

 +4        DO FLOWCKP^BHSFLOW

           IF $DATA(GMTSQIT)

               QUIT 

 +5        WRITE ?2,BHSDAT

 +6        FOR BHSI=0:0

               SET BHSI=$ORDER(BHSDB(BHSI))

               IF 'BHSI

                   QUIT 

               DO FLOWCKP^BHSFLOW

               IF $DATA(GMTSQIT)

                   QUIT 

               DO FLOWD2

               WRITE !

 +7        QUIT 

FLOWD2     FOR BHSJ=0:0

               SET BHSJ=$ORDER(BHSTB(BHSJ))

               IF 'BHSJ

                   QUIT 

               WRITE ?12+BHSTB(BHSJ),":",$GET(BHSDB(BHSI,BHSJ))

 +1        QUIT