- BKM100P1 ;PRXM/HC/ALA-BKM 1.00 Patch 1 ; 27 Sep 2006 10:29 AM
- ;;2.0;HIV MANAGEMENT SYSTEM;;May 29, 2009
- ;
- CND ; Check candidate list and remove entries
- NEW DFN,MED,DFLG,STAT,TAX
- S DFN=0
- F S DFN=$O(^BKM(90451.2,DFN)) Q:'DFN D
- . S STAT=$P(^BKM(90451.2,DFN,0),U,3)
- . I STAT="NOT"!(STAT="REM") Q
- . S MED=0,DFLG=0
- . F S MED=$O(^BKM(90451.2,DFN,3,MED)) Q:'MED D Q:DFLG
- .. S TAX=$P(^BKM(90451.2,DFN,3,MED,0),U,3)
- .. I TAX="BKMV EI MEDS"!(TAX="BKMV NNRTI MEDS")!(TAX="BKMV NRTI MEDS")!(TAX="BKMV PI MEDS") S DFLG=1 Q
- . I DFLG D
- .. NEW DA,DIK
- .. S DA=DFN,DIK="^BKM(90451.2," D ^DIK
- ;
- TX ; Check taxonomies
- NEW TAX,DIC,X,TDA,Y
- S DIC="^ATXAX(",DIC(0)="Z"
- S TAX="BKMV EI MEDS",X=TAX D ^DIC S TDA=+Y
- I TDA'=-1 D
- . NEW DA,VALUE
- . S DA(1)=TDA,DA=0
- . F S DA=$O(^ATXAX(TDA,21,DA)) Q:'DA D
- .. S VALUE=$P(^ATXAX(TDA,21,DA,0),U,1)
- .. I VALUE=5201!(VALUE=83677)!(VALUE=84151) D
- ... S DIK="^ATXAX("_DA(1)_",21," D ^DIK
- ;
- NEW TAX,DIC,X,TDA,Y
- S DIC="^ATXAX(",DIC(0)="Z"
- S TAX="BKMV NNRTI MEDS",X=TAX D ^DIC S TDA=+Y
- I TDA'=-1 D
- . NEW DA,VALUE
- . S DA(1)=TDA,DA=0
- . F S DA=$O(^ATXAX(TDA,21,DA)) Q:'DA D
- .. S VALUE=$P(^ATXAX(TDA,21,DA,0),U,1)
- .. I VALUE=84282!(VALUE=84317)!(VALUE=84318) D
- ... S DIK="^ATXAX("_DA(1)_",21," D ^DIK
- ;
- NEW TAX,DIC,X,TDA,Y
- S DIC="^ATXAX(",DIC(0)="Z"
- S TAX="BKMV NRTI MEDS",X=TAX D ^DIC S TDA=+Y
- I TDA'=-1 D
- . NEW DA,VALUE
- . S DA(1)=TDA,DA=0
- . F S DA=$O(^ATXAX(TDA,21,DA)) Q:'DA D
- .. S VALUE=$P(^ATXAX(TDA,21,DA,0),U,1)
- .. I VALUE=83981!(VALUE=84378)!(VALUE=84431)!(VALUE=84317)!(VALUE=84089) D
- ... S DIK="^ATXAX("_DA(1)_",21," D ^DIK
- ;
- NEW TAX,DIC,X,TDA,Y
- S DIC="^ATXAX(",DIC(0)="Z"
- S TAX="BKMV PI MEDS",X=TAX D ^DIC S TDA=+Y
- I TDA'=-1 D
- . NEW DA,VALUE
- . S DA(1)=TDA,DA=0
- . F S DA=$O(^ATXAX(TDA,21,DA)) Q:'DA D
- .. S VALUE=$P(^ATXAX(TDA,21,DA,0),U,1)
- .. I VALUE=84281!(VALUE=84374)!(VALUE=84318) D
- ... S DIK="^ATXAX("_DA(1)_",21," D ^DIK
- Q
- BKM100P1 ;PRXM/HC/ALA-BKM 1.00 Patch 1 ; 27 Sep 2006 10:29 AM
- +1 ;;2.0;HIV MANAGEMENT SYSTEM;;May 29, 2009
- +2 ;
- CND ; Check candidate list and remove entries
- +1 NEW DFN,MED,DFLG,STAT,TAX
- +2 SET DFN=0
- +3 FOR
- SET DFN=$ORDER(^BKM(90451.2,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:1
- +4 SET STAT=$PIECE(^BKM(90451.2,DFN,0),U,3)
- +5 IF STAT="NOT"!(STAT="REM")
- QUIT
- +6 SET MED=0
- SET DFLG=0
- +7 FOR
- SET MED=$ORDER(^BKM(90451.2,DFN,3,MED))
- IF 'MED
- QUIT
- Begin DoDot:2
- +8 SET TAX=$PIECE(^BKM(90451.2,DFN,3,MED,0),U,3)
- +9 IF TAX="BKMV EI MEDS"!(TAX="BKMV NNRTI MEDS")!(TAX="BKMV NRTI MEDS")!(TAX="BKMV PI MEDS")
- SET DFLG=1
- QUIT
- End DoDot:2
- IF DFLG
- QUIT
- +10 IF DFLG
- Begin DoDot:2
- +11 NEW DA,DIK
- +12 SET DA=DFN
- SET DIK="^BKM(90451.2,"
- DO ^DIK
- End DoDot:2
- End DoDot:1
- +13 ;
- TX ; Check taxonomies
- +1 NEW TAX,DIC,X,TDA,Y
- +2 SET DIC="^ATXAX("
- SET DIC(0)="Z"
- +3 SET TAX="BKMV EI MEDS"
- SET X=TAX
- DO ^DIC
- SET TDA=+Y
- +4 IF TDA'=-1
- Begin DoDot:1
- +5 NEW DA,VALUE
- +6 SET DA(1)=TDA
- SET DA=0
- +7 FOR
- SET DA=$ORDER(^ATXAX(TDA,21,DA))
- IF 'DA
- QUIT
- Begin DoDot:2
- +8 SET VALUE=$PIECE(^ATXAX(TDA,21,DA,0),U,1)
- +9 IF VALUE=5201!(VALUE=83677)!(VALUE=84151)
- Begin DoDot:3
- +10 SET DIK="^ATXAX("_DA(1)_",21,"
- DO ^DIK
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +11 ;
- +12 NEW TAX,DIC,X,TDA,Y
- +13 SET DIC="^ATXAX("
- SET DIC(0)="Z"
- +14 SET TAX="BKMV NNRTI MEDS"
- SET X=TAX
- DO ^DIC
- SET TDA=+Y
- +15 IF TDA'=-1
- Begin DoDot:1
- +16 NEW DA,VALUE
- +17 SET DA(1)=TDA
- SET DA=0
- +18 FOR
- SET DA=$ORDER(^ATXAX(TDA,21,DA))
- IF 'DA
- QUIT
- Begin DoDot:2
- +19 SET VALUE=$PIECE(^ATXAX(TDA,21,DA,0),U,1)
- +20 IF VALUE=84282!(VALUE=84317)!(VALUE=84318)
- Begin DoDot:3
- +21 SET DIK="^ATXAX("_DA(1)_",21,"
- DO ^DIK
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +22 ;
- +23 NEW TAX,DIC,X,TDA,Y
- +24 SET DIC="^ATXAX("
- SET DIC(0)="Z"
- +25 SET TAX="BKMV NRTI MEDS"
- SET X=TAX
- DO ^DIC
- SET TDA=+Y
- +26 IF TDA'=-1
- Begin DoDot:1
- +27 NEW DA,VALUE
- +28 SET DA(1)=TDA
- SET DA=0
- +29 FOR
- SET DA=$ORDER(^ATXAX(TDA,21,DA))
- IF 'DA
- QUIT
- Begin DoDot:2
- +30 SET VALUE=$PIECE(^ATXAX(TDA,21,DA,0),U,1)
- +31 IF VALUE=83981!(VALUE=84378)!(VALUE=84431)!(VALUE=84317)!(VALUE=84089)
- Begin DoDot:3
- +32 SET DIK="^ATXAX("_DA(1)_",21,"
- DO ^DIK
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +33 ;
- +34 NEW TAX,DIC,X,TDA,Y
- +35 SET DIC="^ATXAX("
- SET DIC(0)="Z"
- +36 SET TAX="BKMV PI MEDS"
- SET X=TAX
- DO ^DIC
- SET TDA=+Y
- +37 IF TDA'=-1
- Begin DoDot:1
- +38 NEW DA,VALUE
- +39 SET DA(1)=TDA
- SET DA=0
- +40 FOR
- SET DA=$ORDER(^ATXAX(TDA,21,DA))
- IF 'DA
- QUIT
- Begin DoDot:2
- +41 SET VALUE=$PIECE(^ATXAX(TDA,21,DA,0),U,1)
- +42 IF VALUE=84281!(VALUE=84374)!(VALUE=84318)
- Begin DoDot:3
- +43 SET DIK="^ATXAX("_DA(1)_",21,"
- DO ^DIK
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +44 QUIT
