PSDHLX ;BIR/LTL-HL7 inteface setup invoked by PSDHL7 for X3.28 ; 21 Feb 95
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
X328 W !!,"Let's check for a PSD-NDES X3.28 entry in your",!
W "HL LOWER LEVEL PROTOCOL PARAMETER file (#829.2)."
S (DIC,DIE)="^HLCS(869.2,",DIC(0)="L",DLAYGO=869.2,X="PSD-NDES X3.28"
D ^DIC K DIC W:$P(Y,U,3) "Added." I Y<0 W "Failed." G END
W " Updating.",!! N PSDX S (DA,PSDX)=+Y
S DR=".02////3;300.01//" D ^DIE K DIE,DR,DIC,DA
W !!,"Let's check for a PSD X3.28 entry in your"
W !,"HL LOGICAL LINK file (#870)."
S (DIC,DIE)="^HLCS(870,",DIC(0)="L",DLAYGO=870,X="PSD X3.28"
D ^DIC K DIC W:$P(Y,U,3) "Added." I Y<0 W "Failed." Q
W " Updating." N PSDL S (DA,PSDL)=+Y
S DR="2////"_$G(PSDX) D ^DIE K DIC,DA,DIE,DLAYGO,DR D NONK^PSDHLP
END Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDHLX 783 printed Dec 13, 2024@01:46:23 Page 2
PSDHLX ;BIR/LTL-HL7 inteface setup invoked by PSDHL7 for X3.28 ; 21 Feb 95
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
X328 WRITE !!,"Let's check for a PSD-NDES X3.28 entry in your",!
+1 WRITE "HL LOWER LEVEL PROTOCOL PARAMETER file (#829.2)."
+2 SET (DIC,DIE)="^HLCS(869.2,"
SET DIC(0)="L"
SET DLAYGO=869.2
SET X="PSD-NDES X3.28"
+3 DO ^DIC
KILL DIC
if $PIECE(Y,U,3)
WRITE "Added."
IF Y<0
WRITE "Failed."
GOTO END
+4 WRITE " Updating.",!!
NEW PSDX
SET (DA,PSDX)=+Y
+5 SET DR=".02////3;300.01//"
DO ^DIE
KILL DIE,DR,DIC,DA
+6 WRITE !!,"Let's check for a PSD X3.28 entry in your"
+7 WRITE !,"HL LOGICAL LINK file (#870)."
+8 SET (DIC,DIE)="^HLCS(870,"
SET DIC(0)="L"
SET DLAYGO=870
SET X="PSD X3.28"
+9 DO ^DIC
KILL DIC
if $PIECE(Y,U,3)
WRITE "Added."
IF Y<0
WRITE "Failed."
QUIT
+10 WRITE " Updating."
NEW PSDL
SET (DA,PSDL)=+Y
+11 SET DR="2////"_$GET(PSDX)
DO ^DIE
KILL DIC,DA,DIE,DLAYGO,DR
DO NONK^PSDHLP
END QUIT