- AMQQ33P1 ; IHS/CMI/THL - CODE TO IMPLEMENT ENTRY MODIFICATIONS ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;-----
- D ^XBKVAR
- S DA=202
- S DIE="^AMQQ(1,"
- S DR="11////S AMQT(|20|)=0 S:$D(^AUPNVIMM(AMQP(202),0)) %=$P(^(0),U,6),%=%*1,AMQT(|20|)=(%|10|""|12|""),AMQP(|6|)=% |30|"
- D ^DIE
- K DIE,DA,DR
- S DA=201
- S DIE="^AMQQ(1,"
- S DR="11////S AMQT(|20|)=0 S:$D(^AUPNVIMM(AMQP(201),0)) %=$P(^(0),U,7),%=%*1,AMQT(|20|)=(%|10|""|12|""),AMQP(|6|)=% |30|"
- D ^DIE
- K DIE,DA,DR
- S DA=33
- S DIE="^AMQQ(1,"
- S DR="30////I '+$G(^DPT(AMQP(0),.35)) S AMQT(|20|)=1,AMQP(|6|)="""" |30|;31////S AMQP(|6|)="""",AMQT(|20|)=1 S:+$G(^DPT(AMQP(0),.35)) AMQP(|5|)=+^(.35) |30|"
- D ^DIE
- K DIE,DA,DR
- S DA=147
- S DIE="^AMQQ(1,"
- S DR="10////S AMQP(.1)=""+"" F Q:AMQP(.1)=99999999999 S AMQP(.1)=$O(^DPT(""B"",AMQP(.1))) Q:AMQP(.1)="" F AMQP(0)=0:0 S AMQP(0)=$O(^DPT(""B"",AMQP(.1),AMQP(0))) Q:'AMQP(0) I $D(^(AMQP(0)))=1,^(AMQP(0))="""" S AMQT(|20|)=1 |30|"
- D ^DIE
- K DIE,DA,DR
- S DA=3
- S DIE="^AMQQ(1,"
- S DR="10////S AMQP(.1)=""+"",AMQP(.11)=""|10|"",AMQP(.101)=""|11|"",AMQP(.111)=""|||||"" D START^AMQQFAN S AMQT(|20|)=1 |30|"
- D ^DIE
- K DIE,DA,DR
- S DA(1)=271
- S DA=2
- S DIK="^AMQQ(5,271,1,"
- D ^DIK
- K DIK,DA
- S DA(1)=290
- S DIC="^AMQQ(5,290,1,"
- S DIC(0)="FML"
- S X="CONTRAINDICATED"
- S DIADD=1
- D ^DIC
- K DIC,DA,DR,DIADD
- S DA(1)=291
- S DIC="^AMQQ(5,291,1,"
- S DIC(0)="FML"
- S X="REACTION"
- S DIADD=1
- D ^DIC
- K DIC,DA,DR,DIADD
- S DA=223
- S DIE="^AMQQ(5,"
- S DR="14////SERVICE CATEGORY"
- D ^DIE
- K DIE,DA,DR
- S DA(1)=223
- S DA=1
- S DIE="^AMQQ(5,223,1,"
- S DR=".01///SERVICE CATEGORY"
- D ^DIE
- K DIE,DA,DR
- S DA(1)=223
- S DA=1
- S DIE="^AMQQ(5,223,1,"
- S DR=".01///SERVICE CATEGORY"
- D ^DIE
- K DIE,DA,DR
- W !,"Please wait, this may take a while ."
- S DIK="^AUPNPAT("
- S DIK(1)="1110^AQ1"
- D ENALL^DIK
- K DIK,DA
- W !,*7,"Done!"
- Q
- AMQQ33P1 ; IHS/CMI/THL - CODE TO IMPLEMENT ENTRY MODIFICATIONS ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;-----
- +3 DO ^XBKVAR
- +4 SET DA=202
- +5 SET DIE="^AMQQ(1,"
- +6 SET DR="11////S AMQT(|20|)=0 S:$D(^AUPNVIMM(AMQP(202),0)) %=$P(^(0),U,6),%=%*1,AMQT(|20|)=(%|10|""|12|""),AMQP(|6|)=% |30|"
- +7 DO ^DIE
- +8 KILL DIE,DA,DR
- +9 SET DA=201
- +10 SET DIE="^AMQQ(1,"
- +11 SET DR="11////S AMQT(|20|)=0 S:$D(^AUPNVIMM(AMQP(201),0)) %=$P(^(0),U,7),%=%*1,AMQT(|20|)=(%|10|""|12|""),AMQP(|6|)=% |30|"
- +12 DO ^DIE
- +13 KILL DIE,DA,DR
- +14 SET DA=33
- +15 SET DIE="^AMQQ(1,"
- +16 SET DR="30////I '+$G(^DPT(AMQP(0),.35)) S AMQT(|20|)=1,AMQP(|6|)="""" |30|;31////S AMQP(|6|)="""",AMQT(|20|)=1 S:+$G(^DPT(AMQP(0),.35)) AMQP(|5|)=+^(.35) |30|"
- +17 DO ^DIE
- +18 KILL DIE,DA,DR
- +19 SET DA=147
- +20 SET DIE="^AMQQ(1,"
- +21 SET DR="10////S AMQP(.1)=""+"" F Q:AMQP(.1)=99999999999 S AMQP(.1)=$O(^DPT(""B"",AMQP(.1))) Q:AMQP(.1)="" F AMQP(0)=0:0 S AMQP(0)=$O(^DPT(""B"",AMQP(.1),AMQP(0))) Q:'AMQP(0) I $D(^(AMQP(0)))=1,^(AMQP(0))="""" S AMQT(|20|)=1 |30|"
- +22 DO ^DIE
- +23 KILL DIE,DA,DR
- +24 SET DA=3
- +25 SET DIE="^AMQQ(1,"
- +26 SET DR="10////S AMQP(.1)=""+"",AMQP(.11)=""|10|"",AMQP(.101)=""|11|"",AMQP(.111)=""|||||"" D START^AMQQFAN S AMQT(|20|)=1 |30|"
- +27 DO ^DIE
- +28 KILL DIE,DA,DR
- +29 SET DA(1)=271
- +30 SET DA=2
- +31 SET DIK="^AMQQ(5,271,1,"
- +32 DO ^DIK
- +33 KILL DIK,DA
- +34 SET DA(1)=290
- +35 SET DIC="^AMQQ(5,290,1,"
- +36 SET DIC(0)="FML"
- +37 SET X="CONTRAINDICATED"
- +38 SET DIADD=1
- +39 DO ^DIC
- +40 KILL DIC,DA,DR,DIADD
- +41 SET DA(1)=291
- +42 SET DIC="^AMQQ(5,291,1,"
- +43 SET DIC(0)="FML"
- +44 SET X="REACTION"
- +45 SET DIADD=1
- +46 DO ^DIC
- +47 KILL DIC,DA,DR,DIADD
- +48 SET DA=223
- +49 SET DIE="^AMQQ(5,"
- +50 SET DR="14////SERVICE CATEGORY"
- +51 DO ^DIE
- +52 KILL DIE,DA,DR
- +53 SET DA(1)=223
- +54 SET DA=1
- +55 SET DIE="^AMQQ(5,223,1,"
- +56 SET DR=".01///SERVICE CATEGORY"
- +57 DO ^DIE
- +58 KILL DIE,DA,DR
- +59 SET DA(1)=223
- +60 SET DA=1
- +61 SET DIE="^AMQQ(5,223,1,"
- +62 SET DR=".01///SERVICE CATEGORY"
- +63 DO ^DIE
- +64 KILL DIE,DA,DR
- +65 WRITE !,"Please wait, this may take a while ."
- +66 SET DIK="^AUPNPAT("
- +67 SET DIK(1)="1110^AQ1"
- +68 DO ENALL^DIK
- +69 KILL DIK,DA
- +70 WRITE !,*7,"Done!"
- +71 QUIT
