Routine: PSDHLP

PSDHLP ;BIR/LTL-HL7 inteface setup for logical links on protocols ; 21 Feb 95

 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

NONK ;non-kids type call by ^PSDHL7 & ^PSDHLX

 W !!,"Updating Clients with your selected logical link:",!!

 I $G(PSD(3)) D  Q

 .S DIC="^ORD(101,",DIC(0)="ML",DLAYGO=101

 .F PSD(4)=1:1:3 S X="PSD"_PSD(3)_" A0"_PSD(4)_" CLIENT" D ^DIC W $P(Y,U,2),!! M ^ORD(101,+Y)=^ORD(101,+$O(^ORD(101,"B","PSD A0"_PSD(4)_" CLIENT",0))) S $P(^ORD(101,+Y,0),U)=X,DIK=DIC,(DA,PSD(5))=+Y D IX1^DIK D

 ..S DA=PSD(5),DIE=DIC,DR="770.7////"_$G(PSDL) D ^DIE

 .K DIC,DLAYGO,DIK,DA,DR,DIE

 N DIE,DA,DR,PSD 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////"_$G(PSDL)

 .W PSD,!! S DA=$O(^ORD(101,"B",PSD,0)) D ^DIE

DG ;S DIR(0)="Y",DIR("A")="Would you like to add the PSD PAT ADT Protocol to the DGPM Event Driver now",DIR("?")="^N XQH S XQH =""PSD HL7 ADT"" D EN^XQH"

 ;D ^DIR K DIR D:Y=1 ^PSDONIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDHLP   980     printed  Mar 13, 2025@20:51:03                                                                                                                                                                                                       Page 2

PSDHLP    ;BIR/LTL-HL7 inteface setup for logical links on protocols ; 21 Feb 95

 +1       ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

NONK      ;non-kids type call by ^PSDHL7 & ^PSDHLX

 +1        WRITE !!,"Updating Clients with your selected logical link:",!!

 +2        IF $GET(PSD(3))

               Begin DoDot:1

 +3                SET DIC="^ORD(101,"

                   SET DIC(0)="ML"

                   SET DLAYGO=101

 +4                FOR PSD(4)=1:1:3

                       SET X="PSD"_PSD(3)_" A0"_PSD(4)_" CLIENT"

                       DO ^DIC

                       WRITE $PIECE(Y,U,2),!!

                       MERGE ^ORD(101,+Y)=^ORD(101,+$ORDER(^ORD(101,"B","PSD A0"_PSD(4)_" CLIENT",0)))

                       SET $PIECE(^ORD(101,+Y,0),U)=X

                       SET DIK=DIC

                       SET (DA,PSD(5))=+Y

                       DO IX1^DIK

                       Begin DoDot:2

 +5                        SET DA=PSD(5)

                           SET DIE=DIC

                           SET DR="770.7////"_$GET(PSDL)

                           DO ^DIE

                       End DoDot:2

 +6                KILL DIC,DLAYGO,DIK,DA,DR,DIE

               End DoDot:1

               QUIT

 +7        NEW DIE,DA,DR,PSD

           SET PSD="PSD"

           SET DIE="^ORD(101,"

 +8        FOR

               SET PSD=$ORDER(^ORD(101,"B",PSD))

               if PSD']""!($EXTRACT(PSD,1,3)'="PSD")

                   QUIT

               if PSD["C"

                   Begin DoDot:1

 +9                    SET DR="770.7////"_$GET(PSDL)

 +10                   WRITE PSD,!!

                       SET DA=$ORDER(^ORD(101,"B",PSD,0))

                       DO ^DIE

                   End DoDot:1

DG        ;S DIR(0)="Y",DIR("A")="Would you like to add the PSD PAT ADT Protocol to the DGPM Event Driver now",DIR("?")="^N XQH S XQH =""PSD HL7 ADT"" D EN^XQH"

 +1       ;D ^DIR K DIR D:Y=1 ^PSDONIT

 +2        QUIT

PSDHLP.m