BQITRASM.m

BQITRASM ;GDHS/HCS/ALA-CVD Assessment ; 12 Jun 2016  2:39 PM

 ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17

 ;

EN(TDFN,BQIHSM,ARRAY) ;EP

 NEW MX,BHSN

 S MX=$$MEAS^BQIDCUTL(TDFN,"ACC")

 I MX'=0 S ARRAY="" Q

 S ARRAY(0)=1

 S BHSN=0 F  S BHSN=$O(^APCHSURV(APCHSITI,12,BHSN)) Q:'BHSN  D

 . S ARRAY(BHSN)=^APCHSURV(APCHSITI,12,BHSN,0)

 Q

 ;

APCH ; EP - Tag to be called from Health Summary

 NEW APCHSTAT,BQITXT,APCHSCT,APCHSGHR,APCHSL,LSN

 Q:'$$INAC^APCHSMU(APCHSITI)

 S APCHLAST="",APCHNEXT="" K APCHSTEX

 I $G(APCHCOLW)="" S APCHCOLW=10

 S BQITXT=$P(^APCHSURV(APCHSITI,0),U,1)

 D EN(APCHSPAT,BQITXT,.APCHSTEX)

 M ARRAY=APCHSTEX

 K ^UTILITY($J,"W")

 NEW DIWL,DIWR,BQI,X

 S DIWR=40,DIWL=1

 F BQI=1:1 Q:'$D(APCHSTEX(BQI))  D

 . S X=APCHSTEX(BQI)

 . D ^DIWP

 K APCHSTEX

 S X=0 F  S X=$O(^UTILITY($J,"W",DIWL,X)) Q:X'=+X  S APCHSTEX(X)=^UTILITY($J,"W",DIWL,X,0)

 M ARRAY=APCHSTEX

 D WRITETP^BQITRPHS

 K ^UTILITY($J,"W")

 ;S LSN=$O(ARRAY(""),-1),ARRAY(LSN)=ARRAY(LSN)_$C(30)

 Q

BQITRASM  ;GDHS/HCS/ALA-CVD Assessment ; 12 Jun 2016  2:39 PM

 +1       ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17

 +2       ;

EN(TDFN,BQIHSM,ARRAY) ;EP

 +1        NEW MX,BHSN

 +2        SET MX=$$MEAS^BQIDCUTL(TDFN,"ACC")

 +3        IF MX'=0

               SET ARRAY=""

               QUIT 

 +4        SET ARRAY(0)=1

 +5        SET BHSN=0

           FOR 

               SET BHSN=$ORDER(^APCHSURV(APCHSITI,12,BHSN))

               IF 'BHSN

                   QUIT 

               Begin DoDot:1

 +6                SET ARRAY(BHSN)=^APCHSURV(APCHSITI,12,BHSN,0)

               End DoDot:1

 +7        QUIT 

 +8       ;

APCH      ; EP - Tag to be called from Health Summary

 +1        NEW APCHSTAT,BQITXT,APCHSCT,APCHSGHR,APCHSL,LSN

 +2        IF '$$INAC^APCHSMU(APCHSITI)

               QUIT 

 +3        SET APCHLAST=""

           SET APCHNEXT=""

           KILL APCHSTEX

 +4        IF $GET(APCHCOLW)=""

               SET APCHCOLW=10

 +5        SET BQITXT=$PIECE(^APCHSURV(APCHSITI,0),U,1)

 +6        DO EN(APCHSPAT,BQITXT,.APCHSTEX)

 +7        MERGE ARRAY=APCHSTEX

 +8        KILL ^UTILITY($JOB,"W")

 +9        NEW DIWL,DIWR,BQI,X

 +10       SET DIWR=40

           SET DIWL=1

 +11       FOR BQI=1:1

               IF '$DATA(APCHSTEX(BQI))

                   QUIT 

               Begin DoDot:1

 +12               SET X=APCHSTEX(BQI)

 +13               DO ^DIWP

               End DoDot:1

 +14       KILL APCHSTEX

 +15       SET X=0

           FOR 

               SET X=$ORDER(^UTILITY($JOB,"W",DIWL,X))

               IF X'=+X

                   QUIT 

               SET APCHSTEX(X)=^UTILITY($JOB,"W",DIWL,X,0)

 +16       MERGE ARRAY=APCHSTEX

 +17       DO WRITETP^BQITRPHS

 +18       KILL ^UTILITY($JOB,"W")

 +19      ;S LSN=$O(ARRAY(""),-1),ARRAY(LSN)=ARRAY(LSN)_$C(30)

 +20       QUIT