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
