- BQIRGTH1 ;APTIV/HC/ALA-Trigger RPCs for HMS data fields ; 16 Apr 2008 1:14 PM
- ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- ;
- EN(DATA,DCAT,ETIO,RSTAT,NOTIF,STHREP,STHACS,STAREP,STAACS) ; EP -- BQI REGISTER HMS TRIGGERS
- ; These are small individual value triggers
- ; Input
- ; DCAT - Diagnosis Category (BKMDCAT)
- ; ETIO - Etiology (BKMETIO)
- ; RSTAT - Register Status (BKMSTAT)
- ; NOTIF - Partner Notification Status (BKMPTSTA)
- ; STHREP - State HIV Report Status (BKMSHRST)
- ; STHACS - State HIV Acknowledgement Status (BKMSHAST)
- ; STAREP - State AIDS Report Status (BKMSARST)
- ; STAACS - State AIDS Acknowledgement Status (BKMSAAST)
- ;
- NEW UID,II,BI,LM,TEXT
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQIRGTH1",UID))
- K @DATA
- S II=0
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRGTH1 D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- ;
- S @DATA@(II)="T00008SOURCE^T00001ABLE_FLAG^T01024CLEAR_FIELDS"_$C(30)
- ;
- ;Diagnosis Category
- S DCAT=$G(DCAT,"")
- I DCAT'="" D
- . ; If category is At Risk
- . I DCAT'="A"&(DCAT'="H") D
- .. F BI=1:1 S LM=$T(DCATR+BI) Q:LM=" Q" D
- ... S TEXT=$P(LM,";;",2)
- ... S II=II+1,@DATA@(II)=TEXT_$C(30)
- . ; If category is HIV
- . I DCAT="H" D
- .. F BI=1:1 S LM=$T(DCATH+BI) Q:LM=" Q" D
- ... S TEXT=$P(LM,";;",2)
- ... S II=II+1,@DATA@(II)=TEXT_$C(30)
- . ; If category is AIDS
- . I DCAT="A" D
- .. F BI=1:1 S LM=$T(DCATA+BI) Q:LM=" Q" D
- ... S TEXT=$P(LM,";;",2)
- ... S II=II+1,@DATA@(II)=TEXT_$C(30)
- ;
- ;Etiology
- S ETIO=$G(ETIO,"")
- I ETIO'="",ETIO'="@" S II=II+1,@DATA@(II)="BKMETIOC^Y^"_$C(30)
- I ETIO="@" S II=II+1,@DATA@(II)="BKMETIOC^N^"_$C(30)
- ;
- ;Register Status
- S RSTAT=$G(RSTAT,"")
- I RSTAT'="" S II=II+1,@DATA@(II)="BKMRCOM^Y^"_$C(30)
- ;
- ;Partner Notification Status
- S NOTIF=$G(NOTIF,"")
- I NOTIF'="" D
- . I NOTIF="Y" S II=II+1,@DATA@(II)="BKMPTDT^Y^"_$C(30) Q
- . S II=II+1,@DATA@(II)="BKMPTDT^N^BKMPTDT"_$C(30)
- ;
- ;State HIV Report Status
- S STHREP=$G(STHREP,"")
- I STHREP'="" D
- . I STHREP="Y" D Q
- .. S II=II+1,@DATA@(II)="BKMSHRDT^Y^"_$C(30)
- .. S II=II+1,@DATA@(II)="BKMSHAST^Y^"_$C(30)
- .. ;S II=II+1,@DATA@(II)="BKMSHADT^Y^"_$C(30)
- . S II=II+1,@DATA@(II)="BKMSHRDT^N^BKMSHRDT"_$C(30)
- . S II=II+1,@DATA@(II)="BKMSHADT^N^"_$C(30)
- . S II=II+1,@DATA@(II)="BKMSHAST^N^BKMSHAST;BKMSHADT"_$C(30)
- ;
- ;State HIV Acknowledgement Status
- S STHACS=$G(STHACS,"")
- I STHACS'="" D
- . I STHACS="Y" S II=II+1,@DATA@(II)="BKMSHADT^Y^"_$C(30) Q
- . S II=II+1,@DATA@(II)="BKMSHADT^N^BKMSHADT"_$C(30)
- ;
- ;State AIDS Report Status
- S STAREP=$G(STAREP,"")
- I STAREP'="" D
- . I STAREP="Y" D Q
- .. S II=II+1,@DATA@(II)="BKMSARDT^Y^"_$C(30)
- .. S II=II+1,@DATA@(II)="BKMSAAST^Y^"_$C(30)
- .. ;S II=II+1,@DATA@(II)="BKMSAADT^Y^"_$C(30)
- . S II=II+1,@DATA@(II)="BKMSARDT^N^BKMSARDT"_$C(30)
- . S II=II+1,@DATA@(II)="BKMSAADT^N^"_$C(30)
- . S II=II+1,@DATA@(II)="BKMSAAST^N^BKMSAAST;BKMSAADT"_$C(30)
- ;
- ;State AIDS Acknowledgement Status
- S STAACS=$G(STAACS,"")
- I STAACS'="" D
- . I STAACS="Y" S II=II+1,@DATA@(II)="BKMSAADT^Y^"_$C(30) Q
- . S II=II+1,@DATA@(II)="BKMSAADT^N^BKMSAADT"_$C(30)
- ;
- DONE ;
- S II=II+1,@DATA@(II)=$C(31)
- Q
- ;
- ERR ;
- D ^%ZTER
- NEW Y,ERRDTM
- S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
- S BMXSEC="Recording that an error occurred at "_ERRDTM
- I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
- Q
- ;
- DCATH ;HIV Diagnosis Category
- ;;BKMDCOM^Y^
- ;;BKMDXDT^Y^
- ;;BKMAIDT^N^BKMAIDT
- ;;BKMCLCLS^Y^
- ;;BKMSHRST^Y
- ;;BKMSARST^N
- Q
- ;
- DCATR ;At Risk Category
- ;;BKMDCOM^Y^
- ;;BKMDXDT^N^
- ;;BKMAIDT^N^
- ;;BKMCLCLS^N^BKMCLCLS
- Q
- ;
- DCATA ;AIDS Category
- ;;BKMDCOM^Y^
- ;;BKMDXDT^Y^
- ;;BKMAIDT^Y^
- ;;BKMCLCLS^Y^
- ;;BKMSARST^Y
- Q
- ;
- STAT ; Status trigger
- ;;BKMDCAT^N^
- ;;BKMDCOM^N^
- ;;BKMDXDT^N^
- ;;BKMAIDT^N^
- ;;BKMETIO^N^
- ;;BKMCLCLS^N^
- ;;BKMPTSTA^N^
- ;;BKMHPROV^N^
- ;;BKMHCSMR^N^
- ;;BKMLOC^N^
- ;;BKMSHRST^N^
- ;;BKMSHAST^N^
- ;;BKMSHADT^N^
- ;;BKMSARST^N^
- ;;BKMSAAST^N^
- Q
- BQIRGTH1 ;APTIV/HC/ALA-Trigger RPCs for HMS data fields ; 16 Apr 2008 1:14 PM
- +1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- +2 ;
- EN(DATA,DCAT,ETIO,RSTAT,NOTIF,STHREP,STHACS,STAREP,STAACS) ; EP -- BQI REGISTER HMS TRIGGERS
- +1 ; These are small individual value triggers
- +2 ; Input
- +3 ; DCAT - Diagnosis Category (BKMDCAT)
- +4 ; ETIO - Etiology (BKMETIO)
- +5 ; RSTAT - Register Status (BKMSTAT)
- +6 ; NOTIF - Partner Notification Status (BKMPTSTA)
- +7 ; STHREP - State HIV Report Status (BKMSHRST)
- +8 ; STHACS - State HIV Acknowledgement Status (BKMSHAST)
- +9 ; STAREP - State AIDS Report Status (BKMSARST)
- +10 ; STAACS - State AIDS Acknowledgement Status (BKMSAAST)
- +11 ;
- +12 NEW UID,II,BI,LM,TEXT
- +13 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +14 SET DATA=$NAME(^TMP("BQIRGTH1",UID))
- +15 KILL @DATA
- +16 SET II=0
- +17 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQIRGTH1 D UNWIND^%ZTER"
- +18 ;
- +19 SET @DATA@(II)="T00008SOURCE^T00001ABLE_FLAG^T01024CLEAR_FIELDS"_$CHAR(30)
- +20 ;
- +21 ;Diagnosis Category
- +22 SET DCAT=$GET(DCAT,"")
- +23 IF DCAT'=""
- Begin DoDot:1
- +24 ; If category is At Risk
- +25 IF DCAT'="A"&(DCAT'="H")
- Begin DoDot:2
- +26 FOR BI=1:1
- SET LM=$TEXT(DCATR+BI)
- IF LM=" Q"
- QUIT
- Begin DoDot:3
- +27 SET TEXT=$PIECE(LM,";;",2)
- +28 SET II=II+1
- SET @DATA@(II)=TEXT_$CHAR(30)
- End DoDot:3
- End DoDot:2
- +29 ; If category is HIV
- +30 IF DCAT="H"
- Begin DoDot:2
- +31 FOR BI=1:1
- SET LM=$TEXT(DCATH+BI)
- IF LM=" Q"
- QUIT
- Begin DoDot:3
- +32 SET TEXT=$PIECE(LM,";;",2)
- +33 SET II=II+1
- SET @DATA@(II)=TEXT_$CHAR(30)
- End DoDot:3
- End DoDot:2
- +34 ; If category is AIDS
- +35 IF DCAT="A"
- Begin DoDot:2
- +36 FOR BI=1:1
- SET LM=$TEXT(DCATA+BI)
- IF LM=" Q"
- QUIT
- Begin DoDot:3
- +37 SET TEXT=$PIECE(LM,";;",2)
- +38 SET II=II+1
- SET @DATA@(II)=TEXT_$CHAR(30)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +39 ;
- +40 ;Etiology
- +41 SET ETIO=$GET(ETIO,"")
- +42 IF ETIO'=""
- IF ETIO'="@"
- SET II=II+1
- SET @DATA@(II)="BKMETIOC^Y^"_$CHAR(30)
- +43 IF ETIO="@"
- SET II=II+1
- SET @DATA@(II)="BKMETIOC^N^"_$CHAR(30)
- +44 ;
- +45 ;Register Status
- +46 SET RSTAT=$GET(RSTAT,"")
- +47 IF RSTAT'=""
- SET II=II+1
- SET @DATA@(II)="BKMRCOM^Y^"_$CHAR(30)
- +48 ;
- +49 ;Partner Notification Status
- +50 SET NOTIF=$GET(NOTIF,"")
- +51 IF NOTIF'=""
- Begin DoDot:1
- +52 IF NOTIF="Y"
- SET II=II+1
- SET @DATA@(II)="BKMPTDT^Y^"_$CHAR(30)
- QUIT
- +53 SET II=II+1
- SET @DATA@(II)="BKMPTDT^N^BKMPTDT"_$CHAR(30)
- End DoDot:1
- +54 ;
- +55 ;State HIV Report Status
- +56 SET STHREP=$GET(STHREP,"")
- +57 IF STHREP'=""
- Begin DoDot:1
- +58 IF STHREP="Y"
- Begin DoDot:2
- +59 SET II=II+1
- SET @DATA@(II)="BKMSHRDT^Y^"_$CHAR(30)
- +60 SET II=II+1
- SET @DATA@(II)="BKMSHAST^Y^"_$CHAR(30)
- +61 ;S II=II+1,@DATA@(II)="BKMSHADT^Y^"_$C(30)
- End DoDot:2
- QUIT
- +62 SET II=II+1
- SET @DATA@(II)="BKMSHRDT^N^BKMSHRDT"_$CHAR(30)
- +63 SET II=II+1
- SET @DATA@(II)="BKMSHADT^N^"_$CHAR(30)
- +64 SET II=II+1
- SET @DATA@(II)="BKMSHAST^N^BKMSHAST;BKMSHADT"_$CHAR(30)
- End DoDot:1
- +65 ;
- +66 ;State HIV Acknowledgement Status
- +67 SET STHACS=$GET(STHACS,"")
- +68 IF STHACS'=""
- Begin DoDot:1
- +69 IF STHACS="Y"
- SET II=II+1
- SET @DATA@(II)="BKMSHADT^Y^"_$CHAR(30)
- QUIT
- +70 SET II=II+1
- SET @DATA@(II)="BKMSHADT^N^BKMSHADT"_$CHAR(30)
- End DoDot:1
- +71 ;
- +72 ;State AIDS Report Status
- +73 SET STAREP=$GET(STAREP,"")
- +74 IF STAREP'=""
- Begin DoDot:1
- +75 IF STAREP="Y"
- Begin DoDot:2
- +76 SET II=II+1
- SET @DATA@(II)="BKMSARDT^Y^"_$CHAR(30)
- +77 SET II=II+1
- SET @DATA@(II)="BKMSAAST^Y^"_$CHAR(30)
- +78 ;S II=II+1,@DATA@(II)="BKMSAADT^Y^"_$C(30)
- End DoDot:2
- QUIT
- +79 SET II=II+1
- SET @DATA@(II)="BKMSARDT^N^BKMSARDT"_$CHAR(30)
- +80 SET II=II+1
- SET @DATA@(II)="BKMSAADT^N^"_$CHAR(30)
- +81 SET II=II+1
- SET @DATA@(II)="BKMSAAST^N^BKMSAAST;BKMSAADT"_$CHAR(30)
- End DoDot:1
- +82 ;
- +83 ;State AIDS Acknowledgement Status
- +84 SET STAACS=$GET(STAACS,"")
- +85 IF STAACS'=""
- Begin DoDot:1
- +86 IF STAACS="Y"
- SET II=II+1
- SET @DATA@(II)="BKMSAADT^Y^"_$CHAR(30)
- QUIT
- +87 SET II=II+1
- SET @DATA@(II)="BKMSAADT^N^BKMSAADT"_$CHAR(30)
- End DoDot:1
- +88 ;
- DONE ;
- +1 SET II=II+1
- SET @DATA@(II)=$CHAR(31)
- +2 QUIT
- +3 ;
- ERR ;
- +1 DO ^%ZTER
- +2 NEW Y,ERRDTM
- +3 SET Y=$$NOW^XLFDT()
- XECUTE ^DD("DD")
- SET ERRDTM=Y
- +4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
- +5 IF $DATA(II)
- IF $DATA(DATA)
- SET II=II+1
- SET @DATA@(II)=$CHAR(31)
- +6 QUIT
- +7 ;
- DCATH ;HIV Diagnosis Category
- +1 ;;BKMDCOM^Y^
- +2 ;;BKMDXDT^Y^
- +3 ;;BKMAIDT^N^BKMAIDT
- +4 ;;BKMCLCLS^Y^
- +5 ;;BKMSHRST^Y
- +6 ;;BKMSARST^N
- +7 QUIT
- +8 ;
- DCATR ;At Risk Category
- +1 ;;BKMDCOM^Y^
- +2 ;;BKMDXDT^N^
- +3 ;;BKMAIDT^N^
- +4 ;;BKMCLCLS^N^BKMCLCLS
- +5 QUIT
- +6 ;
- DCATA ;AIDS Category
- +1 ;;BKMDCOM^Y^
- +2 ;;BKMDXDT^Y^
- +3 ;;BKMAIDT^Y^
- +4 ;;BKMCLCLS^Y^
- +5 ;;BKMSARST^Y
- +6 QUIT
- +7 ;
- STAT ; Status trigger
- +1 ;;BKMDCAT^N^
- +2 ;;BKMDCOM^N^
- +3 ;;BKMDXDT^N^
- +4 ;;BKMAIDT^N^
- +5 ;;BKMETIO^N^
- +6 ;;BKMCLCLS^N^
- +7 ;;BKMPTSTA^N^
- +8 ;;BKMHPROV^N^
- +9 ;;BKMHCSMR^N^
- +10 ;;BKMLOC^N^
- +11 ;;BKMSHRST^N^
- +12 ;;BKMSHAST^N^
- +13 ;;BKMSHADT^N^
- +14 ;;BKMSARST^N^
- +15 ;;BKMSAAST^N^
- +16 QUIT
