| 1 | PSDHLK ;BIR/LTL-HL7 inteface for Control Subs invoked by post init ; 21 Feb 95
 | 
|---|
| 2 |  ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
 | 
|---|
| 3 | CHECK ;check for Narcotic Dispensing Equipment System/HL7 interface
 | 
|---|
| 4 |  N DA,DIC,DIE,DLAYGO,DR,PSD,PSDC,PSDN,X,Y
 | 
|---|
| 5 |  D:XPDQUES("POS1")=1  G:XPDQUES("POS1")'=1 END
 | 
|---|
| 6 |  .D MES^XPDUTL("  Updating FACILITY NAME for PSD-CS entry in file #771.")
 | 
|---|
| 7 |  .S DIC="^DIC(4,",DR=99,DA=+$P($G(^XMB(1,1,"XUS")),U,17),DIQ="PSD"
 | 
|---|
| 8 |  .D EN^DIQ1 S PSD=PSD(4,DA,99) K DIC,DR,DIQ,DA
 | 
|---|
| 9 |  .S DIE="^HL(771,",DA=$O(^HL(771,"B","PSD-CS",0))
 | 
|---|
| 10 |  .S DR="3////"_PSD
 | 
|---|
| 11 |  .D ^DIE K DIE,DR,DA,PSD
 | 
|---|
| 12 | PROTO ;Picked HLLP or X3.28 protocol
 | 
|---|
| 13 |  G:XPDQUES("POS2")="X" ^PSDHLY
 | 
|---|
| 14 | HLLP D:XPDQUES("POS2")="H"
 | 
|---|
| 15 |  .S DIE="^HLCS(869.2,",DA=$O(^HLCS(869.2,"B","PSD-NDES HLLP",0))
 | 
|---|
| 16 |  .D MES^XPDUTL("  Updating DEVICE for PSD-NDES HLLP entry in file #869.2.")
 | 
|---|
| 17 |  .S DR="200.01////"_+$G(XPDQUES("POS4")) D ^DIE
 | 
|---|
| 18 |  K DA,DIE,DR
 | 
|---|
| 19 | END Q
 | 
|---|