INHPSAL.m

INHPSAL ;KN ; 11 Jul 96 00:44; MFN Loader Activates Software Application Control Utility - Main

 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 ;COPYRIGHT 1991-2000 SAIC

 ;

 Q

 ;

EN ;Main entry point to interactively process interfaces

 D:'$G(DUZ) ENV^UTIL Q:'$G(DUZ)

 ;Get user parameters

 Q:'$$PARM(.INPAR)

 ;Process user actions

 D PROC(.INPAR)

 ;

 Q

 ;

PROC(INPAR) ;Process selected actions

 ;

 ;Run control routine for interface(s) selected

 S ININT="" F  S ININT=$O(INPAR("APSEL",ININT)) Q:'$L(ININT)  D

 .  ;Run application program

 .  S %=$$PROCINT^INHPSAL1(ININT,.INPAR)

 ;

 Q

 ;

PARM(INPAR) ;Obtain user parameters

 ;OUTPUT:

 ;   INPAR - array of parameters (pbr)

 ;        ("APPL", x ) = interface application data

 ;                       name ^

 ;                          x = inteface application identifier

 ;                          => MDIS, CLIN, MHC, AP, BB 

 ;                          => CIW, TEST, PROTO

 ;        ("APCO" , x ) =  interface name ^ control routine

 ;        ("APSEL", x ) = interface application selected

 ;        ("DESTSEL", x ) = destination selected

 ;        ("DEST", x ) = destination data

 ;    

 ;

 ;Create array of interface applications and control parameters

 D APPLAR

 ;Select an interface

 Q:'$$INTSEL^INHPSAM(.INPAR) 0

 ;Ask for specific destination

 Q:'$$DESTSEL(.INPAR) 0

 ;Ask if OK to continue

 W !!,"WARNING: The MFN Loader can have dramatic effects."

 W ! Q:'$$YN^UTSRD("Are you sure you wish to continue ;0") 0

 W ! Q:'$$YN^UTSRD("Are you absolutely positive you wish to continue ;0") 0

 ;

 Q 1

 ;

DESTSEL(INPAR) ;Select a destination

 ;

 N INEX

 W !!,"Select a destination: ",!

 ;INEX = external system name that user selects, ex AP, BB, TSC

 S INEX=$O(INPAR("APSEL",0))

 ;get the destination string for ext sys name, ex: if BB get HL BLOOD BAN

 S (XYZ)=$P($T(@INEX+1),";;",2,99)

 ;set up and call DIC

 S DIC="^INRHD(",DIC(0)="AEQZ"

 S DIC("S")="I $P(^(0),U)[XYZ"

 D ^DIC

 ;quit if look up fails

 Q:Y=-1 0

 ;+Y contains the ien number.

 S INPAR("DESTIEN")=+Y

 Q 1

 ;

APPLAR ;Create array of interface applications

 ;

 K INPAR N L,L2,NA

 F LC=1:1 S L=$P($T(DATA+LC),";;",2,99) Q:'$L(L)  D

 .  ;S L2=$P($T(DATA+(LC+1)),";;",2,99),NA=$P(L,U,2)

 .  S NA=$P(L,U,2),L2="Q"

 .  ;Quit if no routine or no identifier

 .  Q:'$L(L2)!'$L(NA)

 .  S INPAR("APPL",NA)=L

 .  S INPAR("APCO",NA)=L2

 Q

 ;

DATACOM ;Description of DATA tag

 ;;  format -  ;; interface application name ^  appl indentifier

DATA ;Data

 ;;Anatomic Pathology^AP

 ;;DBSS^BB

 ;;Clinical Integrated Workstation^CIW

 ;;TRICARE Support Contractor^TSC

 ;;

AP ;;DESTINATION: ANATOMIC PATHOLOGY

 ;;ANATOMIC PATHOLOGY

 ;

BB ;;       DESTINATION: HL BLOOD BANK

 ;;HL DBS

 ;

CIW ;;     DESTINATION: HL CIW - OUT

 ;;HL CIW

 ;

TSC ;;     DESTINATION: HL TSC

 ;;HL TSC

 ;

INHPSAL   ;KN ; 11 Jul 96 00:44; MFN Loader Activates Software Application Control Utility - Main

 +1       ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 +2       ;COPYRIGHT 1991-2000 SAIC

 +3       ;

 +4        QUIT 

 +5       ;

EN        ;Main entry point to interactively process interfaces

 +1        IF '$GET(DUZ)

               DO ENV^UTIL

           IF '$GET(DUZ)

               QUIT 

 +2       ;Get user parameters

 +3        IF '$$PARM(.INPAR)

               QUIT 

 +4       ;Process user actions

 +5        DO PROC(.INPAR)

 +6       ;

 +7        QUIT 

 +8       ;

PROC(INPAR) ;Process selected actions

 +1       ;

 +2       ;Run control routine for interface(s) selected

 +3        SET ININT=""

           FOR 

               SET ININT=$ORDER(INPAR("APSEL",ININT))

               IF '$LENGTH(ININT)

                   QUIT 

               Begin DoDot:1

 +4       ;Run application program

 +5                SET %=$$PROCINT^INHPSAL1(ININT,.INPAR)

               End DoDot:1

 +6       ;

 +7        QUIT 

 +8       ;

PARM(INPAR) ;Obtain user parameters

 +1       ;OUTPUT:

 +2       ;   INPAR - array of parameters (pbr)

 +3       ;        ("APPL", x ) = interface application data

 +4       ;                       name ^

 +5       ;                          x = inteface application identifier

 +6       ;                          => MDIS, CLIN, MHC, AP, BB 

 +7       ;                          => CIW, TEST, PROTO

 +8       ;        ("APCO" , x ) =  interface name ^ control routine

 +9       ;        ("APSEL", x ) = interface application selected

 +10      ;        ("DESTSEL", x ) = destination selected

 +11      ;        ("DEST", x ) = destination data

 +12      ;    

 +13      ;

 +14      ;Create array of interface applications and control parameters

 +15       DO APPLAR

 +16      ;Select an interface

 +17       IF '$$INTSEL^INHPSAM(.INPAR)

               QUIT 0

 +18      ;Ask for specific destination

 +19       IF '$$DESTSEL(.INPAR)

               QUIT 0

 +20      ;Ask if OK to continue

 +21       WRITE !!,"WARNING: The MFN Loader can have dramatic effects."

 +22       WRITE !

           IF '$$YN^UTSRD("Are you sure you wish to continue ;0")

               QUIT 0

 +23       WRITE !

           IF '$$YN^UTSRD("Are you absolutely positive you wish to continue ;0")

               QUIT 0

 +24      ;

 +25       QUIT 1

 +26      ;

DESTSEL(INPAR) ;Select a destination

 +1       ;

 +2        NEW INEX

 +3        WRITE !!,"Select a destination: ",!

 +4       ;INEX = external system name that user selects, ex AP, BB, TSC

 +5        SET INEX=$ORDER(INPAR("APSEL",0))

 +6       ;get the destination string for ext sys name, ex: if BB get HL BLOOD BAN

 +7        SET (XYZ)=$PIECE($TEXT(@INEX+1),";;",2,99)

 +8       ;set up and call DIC

 +9        SET DIC="^INRHD("

           SET DIC(0)="AEQZ"

 +10       SET DIC("S")="I $P(^(0),U)[XYZ"

 +11       DO ^DIC

 +12      ;quit if look up fails

 +13       IF Y=-1

               QUIT 0

 +14      ;+Y contains the ien number.

 +15       SET INPAR("DESTIEN")=+Y

 +16       QUIT 1

 +17      ;

APPLAR    ;Create array of interface applications

 +1       ;

 +2        KILL INPAR

           NEW L,L2,NA

 +3        FOR LC=1:1

               SET L=$PIECE($TEXT(DATA+LC),";;",2,99)

               IF '$LENGTH(L)

                   QUIT 

               Begin DoDot:1

 +4       ;S L2=$P($T(DATA+(LC+1)),";;",2,99),NA=$P(L,U,2)

 +5                SET NA=$PIECE(L,U,2)

                   SET L2="Q"

 +6       ;Quit if no routine or no identifier

 +7                IF '$LENGTH(L2)!'$LENGTH(NA)

                       QUIT 

 +8                SET INPAR("APPL",NA)=L

 +9                SET INPAR("APCO",NA)=L2

               End DoDot:1

 +10       QUIT 

 +11      ;

DATACOM   ;Description of DATA tag

 +1       ;;  format -  ;; interface application name ^  appl indentifier

DATA      ;Data

 +1       ;;Anatomic Pathology^AP

 +2       ;;DBSS^BB

 +3       ;;Clinical Integrated Workstation^CIW

 +4       ;;TRICARE Support Contractor^TSC

 +5       ;;

AP        ;;DESTINATION: ANATOMIC PATHOLOGY

 +1       ;;ANATOMIC PATHOLOGY

 +2       ;

BB        ;;       DESTINATION: HL BLOOD BANK

 +1       ;;HL DBS

 +2       ;

CIW       ;;     DESTINATION: HL CIW - OUT

 +1       ;;HL CIW

 +2       ;

TSC       ;;     DESTINATION: HL TSC

 +1       ;;HL TSC

 +2       ;