BKMOFF ;VNGT/HS/ALA - Turn off HIV Management System ; 04 Jun 2008 3:44 PM
;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
;
EN ;EP - Entry point
NEW BKMIEN,OPT,IEN
; Set flag
S BKMIEN=$O(^BKM(90450,"B","HMS REGISTER","")) I BKMIEN="" Q
S BKMUPD(90450,BKMIEN_",",30)=1
D FILE^DIE("","BKMUPD","ERROR")
K BKMUPD
;
S OPT="BKM"
F S OPT=$O(^DIC(19,"B",OPT)) Q:OPT=""!($E(OPT,1,3)'="BKM") D
. S IEN=""
. F S IEN=$O(^DIC(19,"B",OPT,IEN)) Q:IEN="" D
.. S BKMUPD(19,IEN_",",2)="CANNOT ACCESS HMS VIA RPMS - USE ICARE"
D FILE^DIE("","BKMUPD","ERROR")
K BKMUPD
;
;Check HMS Candidate file
NEW STAT,BQDA,BQDFN,TAG
S BQDA=0,TAG=3
F S BQDA=$O(^BKM(90451.2,BQDA)) Q:'BQDA D
. S BQDFN=$P(^BKM(90451.2,BQDA,0),U,1),STAT=$P(^(0),U,3)
. ; if the status is not NOT:NOT ACCEPTED or REM:REMOVED, quit
. I STAT'="NOT"&(STAT'="REM") D Q
.. I $O(^BQIREG("C",BQDFN,TAG,""))'="" Q
.. D EN^BQITDPRC(.DATA,BQDFN,TAG,"P",DATE,"POST INSTALL JOB",1,"Patient originally on HMS Candidate List")
. S DATE=$S($P(^BKM(90451.2,BQDA,0),U,5)'="":$P(^(0),U,5),1:"")
. S USER=$S($P(^BKM(90451.2,BQDA,0),U,6)'="":$P(^VA(200,$P(^(0),U,6),0),U,1),1:"POST INSTALL JOB")
. ; If the recalculate of tags created a record, delete it
. I $O(^BQIREG("C",BQDFN,TAG,""))'="" D
.. NEW DIK,DA
.. S DIK="^BQIREG(",DA=$O(^BQIREG("C",BQDFN,TAG,"")) D ^DIK
.. S DA(1)=BQDFN,DA=TAG,DIK="^BQIPAT("_DA(1)_",20," D ^DIK
. D EN^BQITDPRC(.DATA,BQDFN,TAG,"N",DATE,USER,1,"Patient on HMS Register has status Not Accepted or Removed.")
;
Q
;
HIV ;EP - Check to turn off HIV
NEW BKMHIV,UID
S BKMHIV=$$HIVIEN^BKMIXX3()
I $$GET1^DIQ(90450,BKMHIV_",",30,"I")="" D
. I $$GET1^DIQ(90450,BKMHIV_",",.08,"I")\1'>DT D EN
Q
;
STCS ; Status comments set
NEW TEXT,IENS
S TEXT(1,0)=X
S IENS=$$IENS^DILF(.DA)
D WP^DIE(90451.01,IENS,20,"","TEXT","ERROR")
Q
;
STCK ; Status comments kill
Q
;
DXCS ; Diagnosis comments set
NEW TEXT,IENS
S TEXT(1,0)=X
S IENS=$$IENS^DILF(.DA)
D WP^DIE(90451.01,IENS,21,"","TEXT","ERROR")
Q
;
DXCK ; Diagnosis comments kill
Q
;
ETCS ; Etiology comments set
NEW TEXT,IENS
S TEXT(1,0)=X
S IENS=$$IENS^DILF(.DA)
D WP^DIE(90451.01,IENS,22,"","TEXT","ERROR")
Q
;
ETCK ; Etiology comments kill
Q
BKMOFF ;VNGT/HS/ALA - Turn off HIV Management System ; 04 Jun 2008 3:44 PM
+1 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
EN ;EP - Entry point
+1 NEW BKMIEN,OPT,IEN
+2 ; Set flag
+3 SET BKMIEN=$ORDER(^BKM(90450,"B","HMS REGISTER",""))
IF BKMIEN=""
QUIT
+4 SET BKMUPD(90450,BKMIEN_",",30)=1
+5 DO FILE^DIE("","BKMUPD","ERROR")
+6 KILL BKMUPD
+7 ;
+8 SET OPT="BKM"
+9 FOR
SET OPT=$ORDER(^DIC(19,"B",OPT))
IF OPT=""!($EXTRACT(OPT,1,3)'="BKM")
QUIT
Begin DoDot:1
+10 SET IEN=""
+11 FOR
SET IEN=$ORDER(^DIC(19,"B",OPT,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+12 SET BKMUPD(19,IEN_",",2)="CANNOT ACCESS HMS VIA RPMS - USE ICARE"
End DoDot:2
End DoDot:1
+13 DO FILE^DIE("","BKMUPD","ERROR")
+14 KILL BKMUPD
+15 ;
+16 ;Check HMS Candidate file
+17 NEW STAT,BQDA,BQDFN,TAG
+18 SET BQDA=0
SET TAG=3
+19 FOR
SET BQDA=$ORDER(^BKM(90451.2,BQDA))
IF 'BQDA
QUIT
Begin DoDot:1
+20 SET BQDFN=$PIECE(^BKM(90451.2,BQDA,0),U,1)
SET STAT=$PIECE(^(0),U,3)
+21 ; if the status is not NOT:NOT ACCEPTED or REM:REMOVED, quit
+22 IF STAT'="NOT"&(STAT'="REM")
Begin DoDot:2
+23 IF $ORDER(^BQIREG("C",BQDFN,TAG,""))'=""
QUIT
+24 DO EN^BQITDPRC(.DATA,BQDFN,TAG,"P",DATE,"POST INSTALL JOB",1,"Patient originally on HMS Candidate List")
End DoDot:2
QUIT
+25 SET DATE=$SELECT($PIECE(^BKM(90451.2,BQDA,0),U,5)'="":$PIECE(^(0),U,5),1:"")
+26 SET USER=$SELECT($PIECE(^BKM(90451.2,BQDA,0),U,6)'="":$PIECE(^VA(200,$PIECE(^(0),U,6),0),U,1),1:"POST INSTALL JOB")
+27 ; If the recalculate of tags created a record, delete it
+28 IF $ORDER(^BQIREG("C",BQDFN,TAG,""))'=""
Begin DoDot:2
+29 NEW DIK,DA
+30 SET DIK="^BQIREG("
SET DA=$ORDER(^BQIREG("C",BQDFN,TAG,""))
DO ^DIK
+31 SET DA(1)=BQDFN
SET DA=TAG
SET DIK="^BQIPAT("_DA(1)_",20,"
DO ^DIK
End DoDot:2
+32 DO EN^BQITDPRC(.DATA,BQDFN,TAG,"N",DATE,USER,1,"Patient on HMS Register has status Not Accepted or Removed.")
End DoDot:1
+33 ;
+34 QUIT
+35 ;
HIV ;EP - Check to turn off HIV
+1 NEW BKMHIV,UID
+2 SET BKMHIV=$$HIVIEN^BKMIXX3()
+3 IF $$GET1^DIQ(90450,BKMHIV_",",30,"I")=""
Begin DoDot:1
+4 IF $$GET1^DIQ(90450,BKMHIV_",",.08,"I")\1'>DT
DO EN
End DoDot:1
+5 QUIT
+6 ;
STCS ; Status comments set
+1 NEW TEXT,IENS
+2 SET TEXT(1,0)=X
+3 SET IENS=$$IENS^DILF(.DA)
+4 DO WP^DIE(90451.01,IENS,20,"","TEXT","ERROR")
+5 QUIT
+6 ;
STCK ; Status comments kill
+1 QUIT
+2 ;
DXCS ; Diagnosis comments set
+1 NEW TEXT,IENS
+2 SET TEXT(1,0)=X
+3 SET IENS=$$IENS^DILF(.DA)
+4 DO WP^DIE(90451.01,IENS,21,"","TEXT","ERROR")
+5 QUIT
+6 ;
DXCK ; Diagnosis comments kill
+1 QUIT
+2 ;
ETCS ; Etiology comments set
+1 NEW TEXT,IENS
+2 SET TEXT(1,0)=X
+3 SET IENS=$$IENS^DILF(.DA)
+4 DO WP^DIE(90451.01,IENS,22,"","TEXT","ERROR")
+5 QUIT
+6 ;
ETCK ; Etiology comments kill
+1 QUIT
