PSDHLX.m

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

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