- 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
