ALPBPARM.m

ALPBPARM ;SFVAMC/JC - Parameter Definitions ;05/02/2003  15:24

 ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004

 N DEF,OPR,ZLNK

 N ALPBSCRN,ALPBPARM,ALPBDIVE,ALPBDIVI,ALPBDIVP,ALPBINST,LNK,ERR,DIC,DIE,DA,DR,DIR

 D Q3

 S DIR(0)="Y",DIR("B")="YES" D ^DIR

 I $D(DTOUT)!($D(DUOUT)) G OUT

 S DEF=Y K DA,DIR,Y

 I DEF=1 S ALPBPARM="PSB BKUP DEFAULT"

 ;Associate HL7 Logical Links with division(s)

 I $G(ALPBPARM)']"" S ALPBPARM="PSB BKUP MACHINES"

 S DIR(0)="S^A:Add a Logical Link;D:Delete a Logical Link"

 S DIR("A")="OPERATION",DIR("B")="ADD"

 D ^DIR

 I $D(DTOUT)!($D(DUOUT)) G OUT

 S OPR=Y K DA,DIR,Y

 I DEF=1 D DLINKS G OUT

DIV ;division

 N ALPBDIVP,ALPBDIVI,ALPBDIVE,ALPBINST

 S ALPBDIVP=""

 ;note-parameter file requires institutions instead of divisions

 ;in DIV class

 D Q1 S DIR(0)="PO^40.8:EMZ" D ^DIR

 Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))

 S ALPBDIVI=+Y ;INTERNAL MEDICAL CENTER DIVISION

 S ALPBDIVE=$P(Y,U,2) ;EXTERNAL MED CTR DIVISION

 S ALPBINST=$P(Y(0),U,7) ;INSTITUTION FILE POINTER

 I $G(ALPBINST)']"" W !,"Medical Ctr Divisions must be associated with an institution." G OUT

 S ALPBDIVP="DIV.`"_ALPBINST ;PARAMETER FILE REFERENCE

 I $G(ALPBDIVP)']"" W !,"Division information is required." G OUT

 K DA,DIR,Y

 D LINKS G DIV

 Q

DLINKS ;What logical links for the DEFAULT parmeter?

 K Y S X="BAR CODE MED ADMIN",DIC="^DIC(9.4,",DIC(0)="X",D="B" D IX^DIC

 S ALPBPKG=+$P($G(Y),U,1)

 I '$G(ALPBPKG) W !,"BAR CODE MED ADMIN MISSING FROM PACKAGE FILE." Q

 S ALPBPKG="PKG.`"_ALPBPKG

 K ZLNK

 D GET(.ZLNK)

 I '$D(ZLNK) W !,"No DEFAULT links defined for this package." Q:OPR="D"

 W !,"The following DEFAULT links are associated with this package:"

 S X="" F  S X=$O(ZLNK("LINKS",X)) Q:X<1  D

 . W !,$P(ZLNK("LINKS",X),U,2)

 . I OPR="D" S ALPSCRN($P(ZLNK("LINKS",X),U,2),X)=ZLNK("LINKS",X)

 F  D  Q:$G(DUOUT)!($G(DTOUT))!($G(DIRUT))

 . D Q2

 . I OPR="D" S DIR("S")="I $D(ALPSCRN($P(^HLCS(870,+Y,0),U,1)))"

 . S DIR("A")="Select WorkStation Link "

 . S DIR(0)="PO^870:EMZ" D ^DIR

 . I $G(DUOUT)!($G(DTOUT))!($G(DIRUT)) K DA,DIR,Y Q

 . I Y>0 S RESULT=$$SET(ALPBPKG,$P(Y,U,2))

 . I $G(RESULT)'<1 W !,RESULT

 . K DA,DIR,Y

 K ZLNK

 Q

LINKS ;What logical links for a division?

 W !,"The Institution associated with this division is ",$$NS^XUAF4(ALPBINST)

 D GET(.LNK,ALPBDIVE,1)

 I '$D(LNK),$G(OPR)="D" W !,"No links defined for this division." Q

 W !,"The following links are associated with this division:"

 S X="" F  S X=$O(LNK("LINKS",X)) Q:X<1  D

 . W !,$P(LNK("LINKS",X),U,2)

 . I OPR="D" S ALPSCRN($P(LNK("LINKS",X),U,2),X)=LNK("LINKS",X)

 K LNK

 F  D  Q:$G(DUOUT)!($G(DTOUT))!($G(DIRUT))

 . D Q2

 . I OPR="D" S DIR("S")="I $D(ALPSCRN($P(^HLCS(870,+Y,0),U,1)))"

 . S DIR("A")="Select WorkStation Link "

 . S DIR(0)="PO^870:EMZ" D ^DIR

 . I $G(DUOUT)!($G(DTOUT))!($G(DIRUT)) K DA,DIR,Y Q

 . I Y>0 S RESULT=$$SET(ALPBDIVP,$P(Y,U,2))

 . I $G(RESULT)'<1 W !,RESULT

 . K DA,DIR,Y,RESULT

 Q

SET(ALPBDIVP,LINK) ;function to set or delete parameter for logical link

 ;and returns error response or zero

 I OPR="A" D EN^XPAR(ALPBDIVP,ALPBPARM,LINK,LINK,.ERR) I ERR=0 W "...Added"

 I OPR="D" D DEL^XPAR(ALPBDIVP,ALPBPARM,LINK,.ERR) I ERR=0 W "...Deleted" I $D(ALPSCRN(LINK)) K ALPSCRN(LINK)

 Q ERR

GET(HLL,DIV,FLG,PR) ;Return HLL("LINKS") array for a given patient division

 ;HLL-HLL("links") array - pass by reference

 ;DIV- DIVISION (OPTIONAL)

 ;FLG-1=DON'T RETURN DEFAULT IF DIV IS EMPTY (OPTIONAL)

 ;PR-SUBSCRIBER PROTOCOL TO INCLUDE WITH THE HLL ARRAY (DEF=BCBU ORM RECV) 

 ;or a default group if div null

 I $G(PR)="" S PR="PSB BCBU ORM RECV"

 I +$G(FLG)'=1 S FLG=0

 N LST S LST=""

 I $G(DIV)="" D  G OUT

 . K Y S X="BAR CODE MED ADMIN",DIC="^DIC(9.4,",DIC(0)="X",D="B" D IX^DIC

 . S ALPBPKG=+$P($G(Y),U,1)

 . Q:'ALPBPKG  S ALPBPKG="PKG.`"_ALPBPKG

 . D GETLST^XPAR(.LST,ALPBPKG,"PSB BKUP DEFAULT","E",.ERR)

 . D GET1

 N INST S INST=$$DV(DIV)

 I INST']"" W !,"Unknown Institiution-please review Medical Ctr Division File." G OUT

 D GETLST^XPAR(.LST,"DIV.`"_INST,"PSB BKUP MACHINES","E",.ERR)

 I $O(LST(0))<1!(ERR) D

 . Q:+FLG=1

 . D GET(.HLL,"") ;Try to use default list if no results.

GET1 ;

 I $O(LST(0)),ERR=0 N X S X=0 F  S X=$O(LST(X)) Q:X<1  D

 . Q:$P(LST(X),U,2)']""

 . N LNK870 S LNK870=$P(LST(X),U,2) Q:$E(LNK870,1,2)="VA"  ;don't init hospital

 . S HLL("LINKS",X)=PR_U_$P(LST(X),U,2)

 Q

DV(DV) ;take internal or external division and return institution

 I +DV>0 S X="`"_DV

 N Y,DIC,DA

 S DIC=40.8,DIC(0)="MQZ",X=DV D ^DIC

 I Y'<1 Q $P(Y(0),U,7)

 Q ""

Q1 ;division help

 S DIR("?")=" "

 S DIR("?",1)="If you are associating different workstations with different"

 S DIR("?",2)="divisions, you must choose a division first, then you will be asked"

 S DIR("?",3)="to enter HL7 Logical Links that correspond to this division."

 Q

Q2 ;Link help

 S DIR("?")=" "

 S DIR("?",1)="Each of the workstations you use for BCMA backups will"

 S DIR("?",2)="have a fixed TCP/IP address assigned and an HL7 Logical"

 S DIR("?",3)="Link associated with it. Now your workstations must be"

 S DIR("?",4)="associated with each division you have defined. If you are not a multi-"

 S DIR("?",5)="divisional facility, all workstations will be associated"

 S DIR("?",6)="with only one facility."

 Q

Q3 ;Ask Default

 W !,"Do you want all backup data to go to the same group of"

 W !,"backup devices regardless of the patient's division?"

 Q

OUT ;EXIT

 Q

ALPBPARM  ;SFVAMC/JC - Parameter Definitions ;05/02/2003  15:24

 +1       ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004

 +2        NEW DEF,OPR,ZLNK

 +3        NEW ALPBSCRN,ALPBPARM,ALPBDIVE,ALPBDIVI,ALPBDIVP,ALPBINST,LNK,ERR,DIC,DIE,DA,DR,DIR

 +4        DO Q3

 +5        SET DIR(0)="Y"

           SET DIR("B")="YES"

           DO ^DIR

 +6        IF $DATA(DTOUT)!($DATA(DUOUT))

               GOTO OUT

 +7        SET DEF=Y

           KILL DA,DIR,Y

 +8        IF DEF=1

               SET ALPBPARM="PSB BKUP DEFAULT"

 +9       ;Associate HL7 Logical Links with division(s)

 +10       IF $GET(ALPBPARM)']""

               SET ALPBPARM="PSB BKUP MACHINES"

 +11       SET DIR(0)="S^A:Add a Logical Link;D:Delete a Logical Link"

 +12       SET DIR("A")="OPERATION"

           SET DIR("B")="ADD"

 +13       DO ^DIR

 +14       IF $DATA(DTOUT)!($DATA(DUOUT))

               GOTO OUT

 +15       SET OPR=Y

           KILL DA,DIR,Y

 +16       IF DEF=1

               DO DLINKS

               GOTO OUT

DIV       ;division

 +1        NEW ALPBDIVP,ALPBDIVI,ALPBDIVE,ALPBINST

 +2        SET ALPBDIVP=""

 +3       ;note-parameter file requires institutions instead of divisions

 +4       ;in DIV class

 +5        DO Q1

           SET DIR(0)="PO^40.8:EMZ"

           DO ^DIR

 +6        IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))

               QUIT 

 +7       ;INTERNAL MEDICAL CENTER DIVISION

           SET ALPBDIVI=+Y

 +8       ;EXTERNAL MED CTR DIVISION

           SET ALPBDIVE=$PIECE(Y,U,2)

 +9       ;INSTITUTION FILE POINTER

           SET ALPBINST=$PIECE(Y(0),U,7)

 +10       IF $GET(ALPBINST)']""

               WRITE !,"Medical Ctr Divisions must be associated with an institution."

               GOTO OUT

 +11      ;PARAMETER FILE REFERENCE

           SET ALPBDIVP="DIV.`"_ALPBINST

 +12       IF $GET(ALPBDIVP)']""

               WRITE !,"Division information is required."

               GOTO OUT

 +13       KILL DA,DIR,Y

 +14       DO LINKS

           GOTO DIV

 +15       QUIT 

DLINKS    ;What logical links for the DEFAULT parmeter?

 +1        KILL Y

           SET X="BAR CODE MED ADMIN"

           SET DIC="^DIC(9.4,"

           SET DIC(0)="X"

           SET D="B"

           DO IX^DIC

 +2        SET ALPBPKG=+$PIECE($GET(Y),U,1)

 +3        IF '$GET(ALPBPKG)

               WRITE !,"BAR CODE MED ADMIN MISSING FROM PACKAGE FILE."

               QUIT 

 +4        SET ALPBPKG="PKG.`"_ALPBPKG

 +5        KILL ZLNK

 +6        DO GET(.ZLNK)

 +7        IF '$DATA(ZLNK)

               WRITE !,"No DEFAULT links defined for this package."

               IF OPR="D"

                   QUIT 

 +8        WRITE !,"The following DEFAULT links are associated with this package:"

 +9        SET X=""

           FOR 

               SET X=$ORDER(ZLNK("LINKS",X))

               IF X<1

                   QUIT 

               Begin DoDot:1

 +10               WRITE !,$PIECE(ZLNK("LINKS",X),U,2)

 +11               IF OPR="D"

                       SET ALPSCRN($PIECE(ZLNK("LINKS",X),U,2),X)=ZLNK("LINKS",X)

               End DoDot:1

 +12       FOR 

               Begin DoDot:1

 +13               DO Q2

 +14               IF OPR="D"

                       SET DIR("S")="I $D(ALPSCRN($P(^HLCS(870,+Y,0),U,1)))"

 +15               SET DIR("A")="Select WorkStation Link "

 +16               SET DIR(0)="PO^870:EMZ"

                   DO ^DIR

 +17               IF $GET">GET">GET">GET(DUOUT)!($GET">GET">GET">GET(DTOUT))!($GET">GET">GET">GET(DIRUT))

                       KILL DA,DIR,Y

                       QUIT 

 +18               IF Y>0

                       SET RESULT=$$SET(ALPBPKG,$PIECE(Y,U,2))

 +19               IF $GET(RESULT)'<1

                       WRITE !,RESULT

 +20               KILL DA,DIR,Y

               End DoDot:1

               IF $GET">GET">GET">GET(DUOUT)!($GET">GET">GET">GET(DTOUT))!($GET">GET">GET">GET(DIRUT))

                   QUIT 

 +21       KILL ZLNK

 +22       QUIT 

LINKS     ;What logical links for a division?

 +1        WRITE !,"The Institution associated with this division is ",$$NS^XUAF4(ALPBINST)

 +2        DO GET(.LNK,ALPBDIVE,1)

 +3        IF '$DATA(LNK)

               IF $GET(OPR)="D"

                   WRITE !,"No links defined for this division."

                   QUIT 

 +4        WRITE !,"The following links are associated with this division:"

 +5        SET X=""

           FOR 

               SET X=$ORDER(LNK("LINKS",X))

               IF X<1

                   QUIT 

               Begin DoDot:1

 +6                WRITE !,$PIECE(LNK("LINKS",X),U,2)

 +7                IF OPR="D"

                       SET ALPSCRN($PIECE(LNK("LINKS",X),U,2),X)=LNK("LINKS",X)

               End DoDot:1

 +8        KILL LNK

 +9        FOR 

               Begin DoDot:1

 +10               DO Q2

 +11               IF OPR="D"

                       SET DIR("S")="I $D(ALPSCRN($P(^HLCS(870,+Y,0),U,1)))"

 +12               SET DIR("A")="Select WorkStation Link "

 +13               SET DIR(0)="PO^870:EMZ"

                   DO ^DIR

 +14               IF $GET">GET">GET">GET(DUOUT)!($GET">GET">GET">GET(DTOUT))!($GET">GET">GET">GET(DIRUT))

                       KILL DA,DIR,Y

                       QUIT 

 +15               IF Y>0

                       SET RESULT=$$SET(ALPBDIVP,$PIECE(Y,U,2))

 +16               IF $GET(RESULT)'<1

                       WRITE !,RESULT

 +17               KILL DA,DIR,Y,RESULT

               End DoDot:1

               IF $GET">GET">GET">GET(DUOUT)!($GET">GET">GET">GET(DTOUT))!($GET">GET">GET">GET(DIRUT))

                   QUIT 

 +18       QUIT 

SET(ALPBDIVP,LINK) ;function to set or delete parameter for logical link

 +1       ;and returns error response or zero

 +2        IF OPR="A"

               DO EN^XPAR(ALPBDIVP,ALPBPARM,LINK,LINK,.ERR)

               IF ERR=0

                   WRITE "...Added"

 +3        IF OPR="D"

               DO DEL^XPAR(ALPBDIVP,ALPBPARM,LINK,.ERR)

               IF ERR=0

                   WRITE "...Deleted"

                   IF $DATA(ALPSCRN(LINK))

                       KILL ALPSCRN(LINK)

 +4        QUIT ERR

GET(HLL,DIV,FLG,PR) ;Return HLL("LINKS") array for a given patient division

 +1       ;HLL-HLL("links") array - pass by reference

 +2       ;DIV- DIVISION (OPTIONAL)

 +3       ;FLG-1=DON'T RETURN DEFAULT IF DIV IS EMPTY (OPTIONAL)

 +4       ;PR-SUBSCRIBER PROTOCOL TO INCLUDE WITH THE HLL ARRAY (DEF=BCBU ORM RECV) 

 +5       ;or a default group if div null

 +6        IF $GET(PR)=""

               SET PR="PSB BCBU ORM RECV"

 +7        IF +$GET(FLG)'=1

               SET FLG=0

 +8        NEW LST

           SET LST=""

 +9        IF $GET(DIV)=""

               Begin DoDot:1

 +10               KILL Y

                   SET X="BAR CODE MED ADMIN"

                   SET DIC="^DIC(9.4,"

                   SET DIC(0)="X"

                   SET D="B"

                   DO IX^DIC

 +11               SET ALPBPKG=+$PIECE($GET(Y),U,1)

 +12               IF 'ALPBPKG

                       QUIT 

                   SET ALPBPKG="PKG.`"_ALPBPKG

 +13               DO GETLST^XPAR(.LST,ALPBPKG,"PSB BKUP DEFAULT","E",.ERR)

 +14               DO GET1

               End DoDot:1

               GOTO OUT

 +15       NEW INST

           SET INST=$$DV(DIV)

 +16       IF INST']""

               WRITE !,"Unknown Institiution-please review Medical Ctr Division File."

               GOTO OUT

 +17       DO GETLST^XPAR(.LST,"DIV.`"_INST,"PSB BKUP MACHINES","E",.ERR)

 +18       IF $ORDER(LST(0))<1!(ERR)

               Begin DoDot:1

 +19               IF +FLG=1

                       QUIT 

 +20      ;Try to use default list if no results.

                   DO GET(.HLL,"")

               End DoDot:1

GET1      ;

 +1        IF $ORDER(LST(0))

               IF ERR=0

                   NEW X

                   SET X=0

                   FOR 

                       SET X=$ORDER(LST(X))

                       IF X<1

                           QUIT 

                       Begin DoDot:1

 +2                        IF $PIECE(LST(X),U,2)']""

                               QUIT 

 +3       ;don't init hospital

                           NEW LNK870

                           SET LNK870=$PIECE(LST(X),U,2)

                           IF $EXTRACT(LNK870,1,2)="VA"

                               QUIT 

 +4                        SET HLL("LINKS",X)=PR_U_$PIECE(LST(X),U,2)

                       End DoDot:1

 +5        QUIT 

DV(DV)    ;take internal or external division and return institution

 +1        IF +DV>0

               SET X="`"_DV

 +2        NEW Y,DIC,DA

 +3        SET DIC=40.8

           SET DIC(0)="MQZ"

           SET X=DV

           DO ^DIC

 +4        IF Y'<1

               QUIT $PIECE(Y(0),U,7)

 +5        QUIT ""

Q1        ;division help

 +1        SET DIR("?")=" "

 +2        SET DIR("?",1)="If you are associating different workstations with different"

 +3        SET DIR("?",2)="divisions, you must choose a division first, then you will be asked"

 +4        SET DIR("?",3)="to enter HL7 Logical Links that correspond to this division."

 +5        QUIT 

Q2        ;Link help

 +1        SET DIR("?")=" "

 +2        SET DIR("?",1)="Each of the workstations you use for BCMA backups will"

 +3        SET DIR("?",2)="have a fixed TCP/IP address assigned and an HL7 Logical"

 +4        SET DIR("?",3)="Link associated with it. Now your workstations must be"

 +5        SET DIR("?",4)="associated with each division you have defined. If you are not a multi-"

 +6        SET DIR("?",5)="divisional facility, all workstations will be associated"

 +7        SET DIR("?",6)="with only one facility."

 +8        QUIT 

Q3        ;Ask Default

 +1        WRITE !,"Do you want all backup data to go to the same group of"

 +2        WRITE !,"backup devices regardless of the patient's division?"

 +3        QUIT 

OUT       ;EXIT

 +1        QUIT