BKM2POST ;APTIV/HC/ALA-Post Install for version 2.0 ; 28 Jan 2008 5:33 PM
;;2.0;HIV MANAGEMENT SYSTEM;;May 29, 2009
;
;
EN ;Entry point
NEW DA,DIK
S DA(1)=1,DA=0,DIK="^BKM(90450,"_DA(1)_",11,"
F S DA=$O(^BKM(90450,1,11,DA)) Q:'DA D ^DIK
M ^BKM(90450,1,11)=^XTMP("BKM 2.0",11)
K ^XTMP("BKM 2.0")
;
; Set up date to inactivate the roll and scroll version of HMS
NEW BKMHIV,BKMUPD,NM,IEN
S BKMHIV=$$HIVIEN^BKMIXX3()
S BKMUPD(90450,BKMHIV_",",.08)=$$DATE^BQIUL1("T+3M")
S BKMUPD(90450,BKMHIV_",",30)="@"
S NM="BKM"
F S NM=$O(^DIC(19,"B",NM)) Q:NM=""!($E(NM,1,3)'="BKM") D
. S IEN=""
. F S IEN=$O(^DIC(19,"B",NM,IEN)) Q:IEN="" D
.. S BKMUPD(19,IEN_",",2)="@"
D FILE^DIE("","BKMUPD","ERROR")
;
; Add new HIV taxonomies
D ^BKMFTX
D ^BKMGTX
;
LTAX ; Add Lab Taxonomies to ^ATXLAB
NEW X,DIC,DLAYGO,DA,DR,DIE,Y,LTAX
S DIC="^ATXLAB(",DIC(0)="L",DLAYGO=9002228
; Loop through the Taxonomies as stored in routine BKMVTAX4.
D LDLAB(.LTAX)
F BJ=1:1 Q:'$D(LTAX(BJ)) S X=LTAX(BJ) D
. I $D(^ATXLAB("B",X)) Q ; Skip pre-existing Lab taxonomies
. D ^DIC S DA=+Y
. I DA<1 Q
. S BQTXUP(9002228,DA_",",.02)=$P(X," ",2,999)
. S BQTXUP(9002228,DA_",",.05)=DUZ
. S BQTXUP(9002228,DA_",",.06)=DT
. S BQTXUP(9002228,DA_",",.09)=60
. D FILE^DIE("I","BQTXUP")
. S BQTXUP(9002228,DA_",",.08)="B"
. D FILE^DIE("E","BQTXUP")
;
K DA,BJ,BQTXUP
;
; Update site-defined medication taxonomies
NEW BGPX,BGPNDCT
S BGPX="BKMV EI MEDS",BGPNDCT="BKMV EI MED NDCS" D
. I $O(^ATXAX("B",BGPX,""))="" D ^BKMTXB
. I $O(^ATXAX("B",BGPNDCT,""))="" D ^BQIBTXD
. D SITEMED^BQI2POST(BGPX,BGPNDCT)
S BGPX="BKMV II MEDS",BGPNDCT="BKMV II MED NDCS" D
. I $O(^ATXAX("B",BGPX,""))="" D ^BQIBTXL
. I $O(^ATXAX("B",BGPNDCT,""))="" D ^BQIBTXE
. D SITEMED^BQI2POST(BGPX,BGPNDCT)
S BGPX="BKMV MAC PROPH MEDS",BGPNDCT="BKMV MAC PROPH MED NDCS" D
. I $O(^ATXAX("B",BGPX,""))="" D ^BKMTXC
. I $O(^ATXAX("B",BGPNDCT,""))="" D ^BQIBTXF
. D SITEMED^BQI2POST(BGPX,BGPNDCT)
S BGPX="BKMV NNRTI MEDS",BGPNDCT="BKMV NNRTI MED NDCS" D
. I $O(^ATXAX("B",BGPX,""))="" D ^BKMTXD
. I $O(^ATXAX("B",BGPNDCT,""))="" D ^BQIBTXG
. D SITEMED^BQI2POST(BGPX,BGPNDCT)
S BGPX="BKMV NRTI MEDS",BGPNDCT="BKMV NRTI MED NDCS" D
. I $O(^ATXAX("B",BGPX,""))="" D ^BKMTXE
. I $O(^ATXAX("B",BGPNDCT,""))="" D ^BQIBTXH
. D SITEMED^BQI2POST(BGPX,BGPNDCT)
S BGPX="BKMV NRTI/NNRTI MEDS",BGPNDCT="BKMV NRTI/NNRTI MED NDCS" D
. I $O(^ATXAX("B",BGPX,""))="" D ^BQIBTXM
. I $O(^ATXAX("B",BGPNDCT,""))="" D ^BQIBTXI
. D SITEMED^BQI2POST(BGPX,BGPNDCT)
S BGPX="BKMV PCP PROPH MEDS",BGPNDCT="BKMV PCP PROPH MED NDCS" D
. I $O(^ATXAX("B",BGPX,""))="" D ^BKMTXF
. I $O(^ATXAX("B",BGPNDCT,""))="" D ^BKMDTXP
. D SITEMED^BQI2POST(BGPX,BGPNDCT)
S BGPX="BKMV PI MEDS",BGPNDCT="BKMV PI MED NDCS" D
. I $O(^ATXAX("B",BGPX,""))="" D ^BKMTXG
. I $O(^ATXAX("B",BGPNDCT,""))="" D ^BQIBTXJ
. D SITEMED^BQI2POST(BGPX,BGPNDCT)
S BGPX="BKM TB MEDS",BGPNDCT="BKM TB MED NDCS" D
. I $O(^ATXAX("B",BGPX,""))="" D ^BKMTXA
. I $O(^ATXAX("B",BGPNDCT,""))="" D ^BKMDTXD
. D SITEMED^BQI2POST(BGPX,BGPNDCT)
S BGPX="BKMV NRTI COMBO MEDS",BGPNDCT="BKMV NRTI COMBO MED NDCS" D
. I $O(^ATXAX("B",BGPX,""))="" D ^BKMGTXE
. I $O(^ATXAX("B",BGPNDCT,""))="" D ^BKMFTXZ
. D SITEMED^BQI2POST(BGPX,BGPNDCT)
S BGPX="BKMV PI BOOSTER MEDS",BGPNDCT="BKMV PI BOOSTER MED NDCS" D
. I $O(^ATXAX("B",BGPX,""))="" D ^BKMGTXF
. I $O(^ATXAX("B",BGPNDCT,""))="" D ^BKMGTXC
. D SITEMED^BQI2POST(BGPX,BGPNDCT)
;
TX ; Reset the variable pointer values for the taxonomies
NEW BQIDA,N,X,IEN,VAL,BQIUPD
S BQIDA=1
S N=0
F S N=$O(^BQI(90508,BQIDA,10,N)) Q:'N D
. S X=$P(^BQI(90508,BQIDA,10,N,0),U,1)
. S IEN=N_","_BQIDA_","
. I $P(^BQI(90508,BQIDA,10,N,0),U,5)="T" S VAL=$$STXPT^BQI2POST(X,"L")
. E S VAL=$$STXPT^BQI2POST(X,"N")
. S BQIUPD(90508.03,IEN,.02)=VAL
I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
;
NEW REG,N,X,IEN,VAL,BQIUPD,RP
S REG=0
F S REG=$O(^BQI(90507,REG)) Q:'REG D
. S N=0
. F S N=$O(^BQI(90507,REG,10,N)) Q:'N D
.. S X=$P(^BQI(90507,REG,10,N,0),U,1)
.. S IEN=N_","_REG_","
.. I $P(^BQI(90507,REG,10,N,0),U,5)="T" S VAL=$$STXPT^BQI2POST(X,"L")
.. E S VAL=$$STXPT^BQI2POST(X,"N")
.. S BQIUPD(90507.01,IEN,.02)=VAL
. I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
. ;
. S RP=0
. F S RP=$O(^BQI(90507,REG,20,RP)) Q:'RP D
.. S N=0
.. F S N=$O(^BQI(90507,REG,20,RP,10,N)) Q:'N D
... S X=$P(^BQI(90507,REG,20,RP,10,N,0),U,1)
... S IEN=N_","_RP_","_REG_","
... S TIEN=$O(^BQI(90507,REG,10,"B",X,""))
... I $P(^BQI(90507,REG,10,TIEN,0),U,5)="T" S VAL=$$STXPT^BQI2POST(X,"L")
... E S VAL=$$STXPT^BQI2POST(X,"N")
... S BQIUPD(90507.03,IEN,.02)=VAL
. I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
;
; Load HMS Supplement in ^APCHSUP
NEW BKMDATA,BKMI,BKMJ,BKMD,CIEN
F BKMI=1 S BKMDATA=$P($T(SUP+BKMI),";;",2) D
. NEW X,DIC,DA,BKMUPD,Y
. S X=$P(BKMDATA,"|",1)
. S DIC="^APCHSUP(",DIC(0)="LZ" D ^DIC
. ; If this is not a new entry, quit
. I $P(Y,U,3)'=1 Q
. S DA=+Y
. S BKMUPD(9001022,DA_",",1100)=$P(BKMDATA,"|",2)
. D FILE^DIE("E","BKMUPD","ERROR")
. F BKMJ=1:1 S BKMD=$T(@("S"_BKMI)+BKMJ) Q:BKMD[" Q" S BKWP(BKMJ)=$P(BKMD,";;",2)
. D WP^DIE(9001022,DA_",",1200,"","BKWP","ERROR")
. K BKWP
;
;Move the comments into the new fields, if site has populated HMS register
; STATUS COMMENTS, DIAGNOSIS COMMENTS, and ETIOLOGY COMMENTS
S HIEN=0
F S HIEN=$O(^BKM(90451,HIEN)) Q:'HIEN D
. S RIEN=0
. F S RIEN=$O(^BKM(90451,HIEN,1,RIEN)) Q:'RIEN D
.. NEW DA,IENS
.. S DA(1)=HIEN,DA=RIEN,IENS=$$IENS^DILF(.DA)
.. S PAIRS="1;20^2.7;21^7.5;22"
.. S FILE=90451.01
.. D MOVE(FILE,IENS,PAIRS)
.. S AIEN=0
.. F S AIEN=$O(^BKM(90451,HIEN,1,RIEN,40,AIEN)) Q:'AIEN D
... NEW DA,IENS
... S DA(2)=HIEN,DA(1)=RIEN,DA=AIEN,IENS=$$IENS^DILF(.DA)
... S PAIRS="3;20",FILE=90451.03
... D MOVE(FILE,IENS,PAIRS)
.. S CIEN=0
.. F S CIEN=$O(^BKM(90451,HIEN,1,RIEN,50,CIEN)) Q:'CIEN D
... NEW DA,IENS
... S DA(2)=HIEN,DA(1)=RIEN,DA=CIEN,IENS=$$IENS^DILF(.DA)
... S PAIRS="2;20",FILE=90451.07
... D MOVE(FILE,IENS,PAIRS)
Q
;
MOVE(FILE,IENS,PAIRS) ;EP
NEW FROM,TO,PAIR
F I=1:1:$L(PAIRS,U) D
. S PAIR=$P(PAIRS,U,I),FROM=$P(PAIR,";",1),TO=$P(PAIR,";",2)
. K TEXT
. S TEXT(1,0)=$$GET1^DIQ(FILE,IENS,FROM,"E")
. I $G(TEXT(1,0))="" Q
. D WP^DIE(FILE,IENS,TO,"","TEXT","ERROR")
Q
;
SUP ; Load HMS Supplement in ^APCHSUP
;;HMS PATIENT CARE SUPPLEMENT|D EP^BKMVSUP(APCHSPAT)
Q
;
S1 ;;
;;The HMS Supplement has been designed to display information
;;specifically related to HIV. You will be able to see, at a glance, the
;;relevant labs, related diagnoses, medications and reminders.
Q
;
LDLAB(ARRAY) ;EP - Load site-populated Lab tests
NEW I,TEXT
F I=1:1 S TEXT=$P($T(LAB+I),";;",2) Q:TEXT="" S ARRAY(I)=TEXT
Q
;
LAB ;EP - LAB TESTS (SITE-POPULATED)
;;BKM HEP A TAX
;;
BKM2POST ;APTIV/HC/ALA-Post Install for version 2.0 ; 28 Jan 2008 5:33 PM
+1 ;;2.0;HIV MANAGEMENT SYSTEM;;May 29, 2009
+2 ;
+3 ;
EN ;Entry point
+1 NEW DA,DIK
+2 SET DA(1)=1
SET DA=0
SET DIK="^BKM(90450,"_DA(1)_",11,"
+3 FOR
SET DA=$ORDER(^BKM(90450,1,11,DA))
IF 'DA
QUIT
DO ^DIK
+4 MERGE ^BKM(90450,1,11)=^XTMP("BKM 2.0",11)
+5 KILL ^XTMP("BKM 2.0")
+6 ;
+7 ; Set up date to inactivate the roll and scroll version of HMS
+8 NEW BKMHIV,BKMUPD,NM,IEN
+9 SET BKMHIV=$$HIVIEN^BKMIXX3()
+10 SET BKMUPD(90450,BKMHIV_",",.08)=$$DATE^BQIUL1("T+3M")
+11 SET BKMUPD(90450,BKMHIV_",",30)="@"
+12 SET NM="BKM"
+13 FOR
SET NM=$ORDER(^DIC(19,"B",NM))
IF NM=""!($EXTRACT(NM,1,3)'="BKM")
QUIT
Begin DoDot:1
+14 SET IEN=""
+15 FOR
SET IEN=$ORDER(^DIC(19,"B",NM,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+16 SET BKMUPD(19,IEN_",",2)="@"
End DoDot:2
End DoDot:1
+17 DO FILE^DIE("","BKMUPD","ERROR")
+18 ;
+19 ; Add new HIV taxonomies
+20 DO ^BKMFTX
+21 DO ^BKMGTX
+22 ;
LTAX ; Add Lab Taxonomies to ^ATXLAB
+1 NEW X,DIC,DLAYGO,DA,DR,DIE,Y,LTAX
+2 SET DIC="^ATXLAB("
SET DIC(0)="L"
SET DLAYGO=9002228
+3 ; Loop through the Taxonomies as stored in routine BKMVTAX4.
+4 DO LDLAB(.LTAX)
+5 FOR BJ=1:1
IF '$DATA(LTAX(BJ))
QUIT
SET X=LTAX(BJ)
Begin DoDot:1
+6 ; Skip pre-existing Lab taxonomies
IF $DATA(^ATXLAB("B",X))
QUIT
+7 DO ^DIC
SET DA=+Y
+8 IF DA<1
QUIT
+9 SET BQTXUP(9002228,DA_",",.02)=$PIECE(X," ",2,999)
+10 SET BQTXUP(9002228,DA_",",.05)=DUZ
+11 SET BQTXUP(9002228,DA_",",.06)=DT
+12 SET BQTXUP(9002228,DA_",",.09)=60
+13 DO FILE^DIE("I","BQTXUP")
+14 SET BQTXUP(9002228,DA_",",.08)="B"
+15 DO FILE^DIE("E","BQTXUP")
End DoDot:1
+16 ;
+17 KILL DA,BJ,BQTXUP
+18 ;
+19 ; Update site-defined medication taxonomies
+20 NEW BGPX,BGPNDCT
+21 SET BGPX="BKMV EI MEDS"
SET BGPNDCT="BKMV EI MED NDCS"
Begin DoDot:1
+22 IF $ORDER(^ATXAX("B",BGPX,""))=""
DO ^BKMTXB
+23 IF $ORDER(^ATXAX("B",BGPNDCT,""))=""
DO ^BQIBTXD
+24 DO SITEMED^BQI2POST(BGPX,BGPNDCT)
End DoDot:1
+25 SET BGPX="BKMV II MEDS"
SET BGPNDCT="BKMV II MED NDCS"
Begin DoDot:1
+26 IF $ORDER(^ATXAX("B",BGPX,""))=""
DO ^BQIBTXL
+27 IF $ORDER(^ATXAX("B",BGPNDCT,""))=""
DO ^BQIBTXE
+28 DO SITEMED^BQI2POST(BGPX,BGPNDCT)
End DoDot:1
+29 SET BGPX="BKMV MAC PROPH MEDS"
SET BGPNDCT="BKMV MAC PROPH MED NDCS"
Begin DoDot:1
+30 IF $ORDER(^ATXAX("B",BGPX,""))=""
DO ^BKMTXC
+31 IF $ORDER(^ATXAX("B",BGPNDCT,""))=""
DO ^BQIBTXF
+32 DO SITEMED^BQI2POST(BGPX,BGPNDCT)
End DoDot:1
+33 SET BGPX="BKMV NNRTI MEDS"
SET BGPNDCT="BKMV NNRTI MED NDCS"
Begin DoDot:1
+34 IF $ORDER(^ATXAX("B",BGPX,""))=""
DO ^BKMTXD
+35 IF $ORDER(^ATXAX("B",BGPNDCT,""))=""
DO ^BQIBTXG
+36 DO SITEMED^BQI2POST(BGPX,BGPNDCT)
End DoDot:1
+37 SET BGPX="BKMV NRTI MEDS"
SET BGPNDCT="BKMV NRTI MED NDCS"
Begin DoDot:1
+38 IF $ORDER(^ATXAX("B",BGPX,""))=""
DO ^BKMTXE
+39 IF $ORDER(^ATXAX("B",BGPNDCT,""))=""
DO ^BQIBTXH
+40 DO SITEMED^BQI2POST(BGPX,BGPNDCT)
End DoDot:1
+41 SET BGPX="BKMV NRTI/NNRTI MEDS"
SET BGPNDCT="BKMV NRTI/NNRTI MED NDCS"
Begin DoDot:1
+42 IF $ORDER(^ATXAX("B",BGPX,""))=""
DO ^BQIBTXM
+43 IF $ORDER(^ATXAX("B",BGPNDCT,""))=""
DO ^BQIBTXI
+44 DO SITEMED^BQI2POST(BGPX,BGPNDCT)
End DoDot:1
+45 SET BGPX="BKMV PCP PROPH MEDS"
SET BGPNDCT="BKMV PCP PROPH MED NDCS"
Begin DoDot:1
+46 IF $ORDER(^ATXAX("B",BGPX,""))=""
DO ^BKMTXF
+47 IF $ORDER(^ATXAX("B",BGPNDCT,""))=""
DO ^BKMDTXP
+48 DO SITEMED^BQI2POST(BGPX,BGPNDCT)
End DoDot:1
+49 SET BGPX="BKMV PI MEDS"
SET BGPNDCT="BKMV PI MED NDCS"
Begin DoDot:1
+50 IF $ORDER(^ATXAX("B",BGPX,""))=""
DO ^BKMTXG
+51 IF $ORDER(^ATXAX("B",BGPNDCT,""))=""
DO ^BQIBTXJ
+52 DO SITEMED^BQI2POST(BGPX,BGPNDCT)
End DoDot:1
+53 SET BGPX="BKM TB MEDS"
SET BGPNDCT="BKM TB MED NDCS"
Begin DoDot:1
+54 IF $ORDER(^ATXAX("B",BGPX,""))=""
DO ^BKMTXA
+55 IF $ORDER(^ATXAX("B",BGPNDCT,""))=""
DO ^BKMDTXD
+56 DO SITEMED^BQI2POST(BGPX,BGPNDCT)
End DoDot:1
+57 SET BGPX="BKMV NRTI COMBO MEDS"
SET BGPNDCT="BKMV NRTI COMBO MED NDCS"
Begin DoDot:1
+58 IF $ORDER(^ATXAX("B",BGPX,""))=""
DO ^BKMGTXE
+59 IF $ORDER(^ATXAX("B",BGPNDCT,""))=""
DO ^BKMFTXZ
+60 DO SITEMED^BQI2POST(BGPX,BGPNDCT)
End DoDot:1
+61 SET BGPX="BKMV PI BOOSTER MEDS"
SET BGPNDCT="BKMV PI BOOSTER MED NDCS"
Begin DoDot:1
+62 IF $ORDER(^ATXAX("B",BGPX,""))=""
DO ^BKMGTXF
+63 IF $ORDER(^ATXAX("B",BGPNDCT,""))=""
DO ^BKMGTXC
+64 DO SITEMED^BQI2POST(BGPX,BGPNDCT)
End DoDot:1
+65 ;
TX ; Reset the variable pointer values for the taxonomies
+1 NEW BQIDA,N,X,IEN,VAL,BQIUPD
+2 SET BQIDA=1
+3 SET N=0
+4 FOR
SET N=$ORDER(^BQI(90508,BQIDA,10,N))
IF 'N
QUIT
Begin DoDot:1
+5 SET X=$PIECE(^BQI(90508,BQIDA,10,N,0),U,1)
+6 SET IEN=N_","_BQIDA_","
+7 IF $PIECE(^BQI(90508,BQIDA,10,N,0),U,5)="T"
SET VAL=$$STXPT^BQI2POST(X,"L")
+8 IF '$TEST
SET VAL=$$STXPT^BQI2POST(X,"N")
+9 SET BQIUPD(90508.03,IEN,.02)=VAL
End DoDot:1
+10 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+11 ;
+12 NEW REG,N,X,IEN,VAL,BQIUPD,RP
+13 SET REG=0
+14 FOR
SET REG=$ORDER(^BQI(90507,REG))
IF 'REG
QUIT
Begin DoDot:1
+15 SET N=0
+16 FOR
SET N=$ORDER(^BQI(90507,REG,10,N))
IF 'N
QUIT
Begin DoDot:2
+17 SET X=$PIECE(^BQI(90507,REG,10,N,0),U,1)
+18 SET IEN=N_","_REG_","
+19 IF $PIECE(^BQI(90507,REG,10,N,0),U,5)="T"
SET VAL=$$STXPT^BQI2POST(X,"L")
+20 IF '$TEST
SET VAL=$$STXPT^BQI2POST(X,"N")
+21 SET BQIUPD(90507.01,IEN,.02)=VAL
End DoDot:2
+22 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+23 ;
+24 SET RP=0
+25 FOR
SET RP=$ORDER(^BQI(90507,REG,20,RP))
IF 'RP
QUIT
Begin DoDot:2
+26 SET N=0
+27 FOR
SET N=$ORDER(^BQI(90507,REG,20,RP,10,N))
IF 'N
QUIT
Begin DoDot:3
+28 SET X=$PIECE(^BQI(90507,REG,20,RP,10,N,0),U,1)
+29 SET IEN=N_","_RP_","_REG_","
+30 SET TIEN=$ORDER(^BQI(90507,REG,10,"B",X,""))
+31 IF $PIECE(^BQI(90507,REG,10,TIEN,0),U,5)="T"
SET VAL=$$STXPT^BQI2POST(X,"L")
+32 IF '$TEST
SET VAL=$$STXPT^BQI2POST(X,"N")
+33 SET BQIUPD(90507.03,IEN,.02)=VAL
End DoDot:3
End DoDot:2
+34 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:1
+35 ;
+36 ; Load HMS Supplement in ^APCHSUP
+37 NEW BKMDATA,BKMI,BKMJ,BKMD,CIEN
+38 FOR BKMI=1
SET BKMDATA=$PIECE($TEXT(SUP+BKMI),";;",2)
Begin DoDot:1
+39 NEW X,DIC,DA,BKMUPD,Y
+40 SET X=$PIECE(BKMDATA,"|",1)
+41 SET DIC="^APCHSUP("
SET DIC(0)="LZ"
DO ^DIC
+42 ; If this is not a new entry, quit
+43 IF $PIECE(Y,U,3)'=1
QUIT
+44 SET DA=+Y
+45 SET BKMUPD(9001022,DA_",",1100)=$PIECE(BKMDATA,"|",2)
+46 DO FILE^DIE("E","BKMUPD","ERROR")
+47 FOR BKMJ=1:1
SET BKMD=$TEXT(@("S"_BKMI)+BKMJ)
IF BKMD[" Q"
QUIT
SET BKWP(BKMJ)=$PIECE(BKMD,";;",2)
+48 DO WP^DIE(9001022,DA_",",1200,"","BKWP","ERROR")
+49 KILL BKWP
End DoDot:1
+50 ;
+51 ;Move the comments into the new fields, if site has populated HMS register
+52 ; STATUS COMMENTS, DIAGNOSIS COMMENTS, and ETIOLOGY COMMENTS
+53 SET HIEN=0
+54 FOR
SET HIEN=$ORDER(^BKM(90451,HIEN))
IF 'HIEN
QUIT
Begin DoDot:1
+55 SET RIEN=0
+56 FOR
SET RIEN=$ORDER(^BKM(90451,HIEN,1,RIEN))
IF 'RIEN
QUIT
Begin DoDot:2
+57 NEW DA,IENS
+58 SET DA(1)=HIEN
SET DA=RIEN
SET IENS=$$IENS^DILF(.DA)
+59 SET PAIRS="1;20^2.7;21^7.5;22"
+60 SET FILE=90451.01
+61 DO MOVE(FILE,IENS,PAIRS)
+62 SET AIEN=0
+63 FOR
SET AIEN=$ORDER(^BKM(90451,HIEN,1,RIEN,40,AIEN))
IF 'AIEN
QUIT
Begin DoDot:3
+64 NEW DA,IENS
+65 SET DA(2)=HIEN
SET DA(1)=RIEN
SET DA=AIEN
SET IENS=$$IENS^DILF(.DA)
+66 SET PAIRS="3;20"
SET FILE=90451.03
+67 DO MOVE(FILE,IENS,PAIRS)
End DoDot:3
+68 SET CIEN=0
+69 FOR
SET CIEN=$ORDER(^BKM(90451,HIEN,1,RIEN,50,CIEN))
IF 'CIEN
QUIT
Begin DoDot:3
+70 NEW DA,IENS
+71 SET DA(2)=HIEN
SET DA(1)=RIEN
SET DA=CIEN
SET IENS=$$IENS^DILF(.DA)
+72 SET PAIRS="2;20"
SET FILE=90451.07
+73 DO MOVE(FILE,IENS,PAIRS)
End DoDot:3
End DoDot:2
End DoDot:1
+74 QUIT
+75 ;
MOVE(FILE,IENS,PAIRS) ;EP
+1 NEW FROM,TO,PAIR
+2 FOR I=1:1:$LENGTH(PAIRS,U)
Begin DoDot:1
+3 SET PAIR=$PIECE(PAIRS,U,I)
SET FROM=$PIECE(PAIR,";",1)
SET TO=$PIECE(PAIR,";",2)
+4 KILL TEXT
+5 SET TEXT(1,0)=$$GET1^DIQ(FILE,IENS,FROM,"E")
+6 IF $GET(TEXT(1,0))=""
QUIT
+7 DO WP^DIE(FILE,IENS,TO,"","TEXT","ERROR")
End DoDot:1
+8 QUIT
+9 ;
SUP ; Load HMS Supplement in ^APCHSUP
+1 ;;HMS PATIENT CARE SUPPLEMENT|D EP^BKMVSUP(APCHSPAT)
+2 QUIT
+3 ;
S1 ;;
+1 ;;The HMS Supplement has been designed to display information
+2 ;;specifically related to HIV. You will be able to see, at a glance, the
+3 ;;relevant labs, related diagnoses, medications and reminders.
+4 QUIT
+5 ;
LDLAB(ARRAY) ;EP - Load site-populated Lab tests
+1 NEW I,TEXT
+2 FOR I=1:1
SET TEXT=$PIECE($TEXT(LAB+I),";;",2)
IF TEXT=""
QUIT
SET ARRAY(I)=TEXT
+3 QUIT
+4 ;
LAB ;EP - LAB TESTS (SITE-POPULATED)
+1 ;;BKM HEP A TAX
+2 ;;
