PSDHLY ;BIR/LTL-HL7 inteface setup invoked by PSDHL7 for X3.28 ; 21 Feb 95
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
X328 N DIE,DA,DR,PSD
S DIE="^HLCS(869.2,",(DA,PSD(1))=$O(^HLCS(869.2,"B","PSD-NDES X3.28",0))
D MES^XPDUTL(" Updating device for PSD-NDES X3.28 entry in file #869.2.")
S DR="300.01////"_+$G(XPDQUES("POS3")) D ^DIE K DIE,DR,DA
D MES^XPDUTL("Updating Clients with your X3.28 logical link:")
S PSD="PSD",DIE="^ORD(101,"
F S PSD=$O(^ORD(101,"B",PSD)) Q:PSD']""!($E(PSD,1,3)'="PSD") D:PSD["C"
.S DR="770.7////"_PSD(1) D MES^XPDUTL(PSD)
.S DA=$O(^ORD(101,"B",PSD,0)) D ^DIE
END Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDHLY 614 printed Dec 13, 2024@01:46:24 Page 2
PSDHLY ;BIR/LTL-HL7 inteface setup invoked by PSDHL7 for X3.28 ; 21 Feb 95
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
X328 NEW DIE,DA,DR,PSD
+1 SET DIE="^HLCS(869.2,"
SET (DA,PSD(1))=$ORDER(^HLCS(869.2,"B","PSD-NDES X3.28",0))
+2 DO MES^XPDUTL(" Updating device for PSD-NDES X3.28 entry in file #869.2.")
+3 SET DR="300.01////"_+$GET(XPDQUES("POS3"))
DO ^DIE
KILL DIE,DR,DA
+4 DO MES^XPDUTL("Updating Clients with your X3.28 logical link:")
+5 SET PSD="PSD"
SET DIE="^ORD(101,"
+6 FOR
SET PSD=$ORDER(^ORD(101,"B",PSD))
if PSD']""!($EXTRACT(PSD,1,3)'="PSD")
QUIT
if PSD["C"
Begin DoDot:1
+7 SET DR="770.7////"_PSD(1)
DO MES^XPDUTL(PSD)
+8 SET DA=$ORDER(^ORD(101,"B",PSD,0))
DO ^DIE
End DoDot:1
END QUIT
