Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: INHPSAM

INHPSAM.m

Go to the documentation of this file. 
  1. INHPSAM ; FRW ; 18 Aug 1999 09:23:25; Interface Application control utility - main
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  Q
  1.  ;
  1. TASKDEV(INPAR,INVERBOS) ; ask for device name and task to process the user action
  1.  ;Input:
  1.  ;   INPAR -  array of parameters
  1.  ;   INVERBOS - verbose
  1.  ;   INDISCRP - if set to one and user  action is show
  1.  ;              it shows the dicrepancies report too
  1.  N %ZIS,X,ZTDESC,ZTIO,ZTRTN,ZTSAVE
  1.  ;Device handling & Tasking logic
  1.  K IOP S %ZIS("A")="QUEUE ON DEVICE: ",%ZIS("B")="",%ZIS="NQ" D ^%ZIS G:POP QUIT
  1.  S IOP=ION_";"_IOST_";"_IOM_";"_IOSL
  1.  I IO=IO(0) S %ZIS="" D ^%ZIS I POP W *7,!,"Sorry, unable to find device..." G QUIT
  1.  I IO'=IO(0) S ZTDESC="Interface application Control utility",ZTIO=IOP,ZTRTN="PROC^INHPSAM(.INPAR)" D  G QUIT
  1.  .F X="INPAR(","INVERBOS","INDISCRP" S ZTSAVE(X)=""
  1.  .D ^%ZTLOAD
  1. ENQUE ; Taskman entry point - Process user actions
  1.  D PROC(.INPAR,INVERBOS)
  1.  G QUIT
  1.  ;
  1. QUIT ;exit module
  1.  D ^%ZISC K IO("Q"),IOP,POP
  1.  Q
  1.  ;---------------------------------------------------------
  1. SHOWONLY ;Main entry point to show only process interfaces
  1.  ;  this entry is called from a menu option
  1.  N INSHOWME
  1.  S INSHOWME=1
  1.  D EN
  1.  Q
  1.  ;
  1. EN ;Main entry point to interactively process interfaces
  1.  N INPAR,INVERBOS
  1.  D:'$G(DUZ) ENV^UTIL
  1.  ;Get user parameters
  1.  Q:'$$PARM(.INPAR)
  1.  ;ask decvice  and task to Process user actions
  1.  D TASKDEV(.INPAR,$G(INVERBOS))
  1.  ;
  1.  Q
  1.  ;
  1. SUMALL ;display summary of all production interfaces
  1.  ;
  1.  D:'$G(DUZ) ENV^UTIL
  1.  D ALL(3)
  1.  Q
  1.  ;
  1. SHOWALL ;show all production interfaces
  1.  ;
  1.  D:'$G(DUZ) ENV^UTIL
  1.  D ALL(2)
  1.  Q
  1.  ;
  1. ACTIV ;Activate all production interfaces
  1.  ;
  1.  D ALL(1)
  1.  Q
  1.  ;
  1. DEACT ;Deactivate all production interfaces
  1.  ;
  1.  D ALL(0)
  1.  Q
  1.  ;
  1. ALL(INST) ;Process all production interfaces
  1.  ;
  1.  N INVERBOS,X,INPAR
  1.  ;S INVERBOS=1
  1.  D APPLAR
  1.  S INST=+$G(INST),INPAR("ACT")=INST,INPAR("REPL")=0
  1.  F X="TRAC","AP","BB","BCC","CHCSII","CIW","CLIN","CRSPL","CRSPR","DINPACS","HIV","ITS","DMHRS","LSI","MDIS","MHC","NMIS","PDTS","PMN","PWS","TSC","TSCL" S INPAR("APSEL",X)=""
  1.  D TASKDEV(.INPAR,$G(INVERBOS))
  1.  ;
  1.  Q
  1.  ;
  1. COMPSUM(INPAR) ;  compile and report the status of all interfaces
  1.  ;Input:
  1.  ;  INPAR - array of parameters for all interfaces
  1.  ;
  1.  N HDR,INPAGE,INTER,INPARFND,INMTF,INTIME
  1.  S INPAGE=0
  1.  S INMTF=$$GETMTF^INHPSA(),INTIME=$$CDATASC^%ZTFDT($H,1,1)
  1.  S HDR(1)="INMTF,?(IOM-27),INTIME,"" PAGE:"",$J(INPAGE,4)"
  1.  S HDR(2)="""Interface Status"""
  1.  S HDR(3)="",$P(HDR(3),"-",IOM)="",HDR(3)=""""_HDR(3)_""",!"
  1.  ;S HDR(1)="""Interface Status"",?(IOM-10),""PAGE:"",$J(INPAGE,4)"
  1.  ;S HDR(2)="",$P(HDR(2),"-",IOM)="",HDR(2)=""""_HDR(2)_""",!"
  1.  D HEADER^INHMG
  1.  S INTER=""
  1.  F  S INTER=$O(INPAR("APSEL",INTER)) Q:'$L(INTER)!$G(DUOUT)  D PROCSUM(INTER,.INPAR,.INPARFND)
  1.  Q:$G(DUOUT)
  1.  I $G(INPARFND) D
  1.  .D T^INHMG1 W !
  1.  .D T^INHMG1 W " *PARTIAL means that an interface has both active and inactive transactions."
  1.  .D T^INHMG1 W "          This usually means that the transactions are used by multiple"
  1.  .D T^INHMG1 W "          interfaces."
  1.  Q
  1. PROCSUM(INTER,INPAR,INPARFND) ; process and report the status of one interface only
  1.  ;Input:
  1.  ;  INTER - interface application identifier
  1.  ;  INPAR - array of parameters for all interfaces
  1.  ;  INPARFND - if set it means that this interface has both active
  1.  ;             and inactive transactions (PARTIAL)
  1.  ;
  1.  N INDAT,INREC,ACTIVE,INACTIVE,STAT,DA,DIC,X,Y,INNAME
  1.  S (ACTIVE,INACTIVE)=0
  1.  I '$$CREDAT^INHPSA(.INDAT) D T^INHMG1 W "ERROR: "_INTER_" Unable to create data array" Q
  1.  S INREC=0
  1.  F  S INREC=$O(INDAT(INTER,4004,INREC)) Q:'INREC  D
  1.  .S (INNAME,X)=$P(INDAT(INTER,4004,INREC),U)
  1.  .S DIC=4004,DIC(0)="",Y=$$DIC^INHPSA(DIC,X,"",DIC(0)),DA=+Y
  1.  .I INNAME'=$P(Y,U,2) D T^INHMG1 W "ERROR: Wanted background process ",INNAME," but found ",$P(Y,U,2)," (",+Y,")." Q 0
  1.  .I DA<0 D T^INHMG1 W "ERROR:  Background Process: ",INNAME," not found."
  1.  .I $P($G(^INTHPC(DA,0)),U,2) S ACTIVE=1
  1.  .E  S INACTIVE=1
  1.  ;
  1.  S INREC=0
  1.  F  S INREC=$O(INDAT(INTER,4000,INREC)) Q:'INREC  D
  1.  .I $P(INDAT(INTER,4000,INREC),U,2) Q    ; do not include this transaction if suppress deactivation flag is set
  1.  .S (INNAME,X)=$P(INDAT(INTER,4000,INREC),U)
  1.  .S DIC=4000,DIC(0)="",Y=$$DIC^INHPSA(DIC,X,"",DIC(0)),DA=+Y
  1.  .I DA<0 D T^INHMG1 W "ERROR:  Transaction Type: ",INNAME," not found. But found ",$P(Y,U,2)," (",+Y,")." Q
  1.  .I INNAME'=$P(Y,U,2) D T^INHMG1 W "ERROR: Wanted transaction type ",INNAME
  1.  .I $P($G(^INRHT(DA,0)),U,5) S ACTIVE=1
  1.  .E  S INACTIVE=1
  1.  ;
  1.  S STAT=""
  1.  I ACTIVE,'INACTIVE S STAT="ACTIVE"
  1.  I 'ACTIVE,INACTIVE S STAT="INACTIVE"
  1.  I ACTIVE,INACTIVE S STAT="PARTIAL",INPARFND=1
  1.  D T^INHMG1 Q:$G(DUOUT)  W STAT,?11,INTER,?20,$P(INPAR("APPL",INTER),U)
  1.  Q
  1.  ;
  1. PROC(INPAR,INVERBOS) ;Process selected actions
  1.  ;Input:
  1.  ;   INPAR -  array of parameters
  1.  ;   INVERBOS - verbose
  1.  ;   INDISCRP - if set to one and user  action is show
  1.  ;              it shows the dicrepancies report too
  1.  ;
  1.  N DUOUT
  1.  I INPAR("ACT")=3 D COMPSUM(.INPAR) Q
  1.  N INPAGE,ININT,INNOOUT
  1.  I INPAR("ACT")<2 S INNOOUT=1   ;do not let user to abort if activating or deactivating
  1.  ;Run control routine for interface(s) selected
  1.  S INPAGE=0
  1.  S ININT="" F  S ININT=$O(INPAR("APSEL",ININT)) Q:'$L(ININT)!$G(DUOUT)  D
  1.  .  ;?? Preprocess to verify that application will load correctly
  1.  .  ;
  1.  .  ;Run application program
  1.  .  S %=$$PROCINT^INHPSA(ININT,.INPAR)
  1.  ;
  1.  Q
  1.  ;
  1. PARM(INPAR) ;Obtain user parameters
  1.  ;OUTPUT:
  1.  ;   INPAR - array of parameters (pbr)
  1.  ;        ("APPL", x ) = interface application data
  1.  ;                       name ^
  1.  ;                          x = interface application identifier
  1.  ;                          => MDIS, CLIN, MHC, AP, BB
  1.  ;                          => CIW, TEST, PROTO
  1.  ;        ("APCO" , x ) =  interface name ^ control routine
  1.  ;        ("APSEL", x ) = interface application selected
  1.  ;        ("REPL")   =  replicate ( 1 - yes ; 0 - no (def) )
  1.  ;        ("ACT")    =  action ( 1- activate ; 0 - deactivate
  1.  ;                               2 - show)
  1.  ;
  1.  ;
  1.  ;Create array of interface applications and control parameters
  1.  D APPLAR
  1.  ;Select an interface
  1.  Q:'$$INTSEL(.INPAR) 0
  1.  ;How created (replicated or parent) - default to parent - DEFER
  1.  S INPAR("REPL")=0
  1.  ;---I $G(XQO)'="" S INPAR("ACT")=2 Q 1     ;if this program was entered from a menu then this is a show action only
  1.  I $G(INSHOWME) S INPAR("ACT")=2 Q 1     ;if this is a show only,  do not ask for activate or deactivate
  1.  ;Select an action (activate or deactivate)
  1.  W !! S %=$$SOC^UTIL("Select Action: ;;;1,30","","SHOW^ACTIVATE^DEACTIVATE",0)
  1.  Q:'$L(%)!(%[U) 0 S INPAR("ACT")=$S($E(%,U,4)["DEAC":0,$E(%,U,4)["ACTI":1,1:2)
  1.  I INPAR("ACT")=2 Q 1    ; this is a show action
  1.  ;Ask if OK to continue
  1.  W !!,"WARNING: Modifying the status of interfaces can have dramatic effects."
  1.  W ! Q:'$$YN^UTSRD("Are you sure you wish to continue ;0") 0
  1.  W ! Q:'$$YN^UTSRD("Are you absolutely positive you wish to continue ;0") 0
  1.  ;
  1.  Q 1
  1.  ;
  1. INTSEL(INPAR) ;Select an interface
  1.  ;
  1.  N DAT,%
  1.  W !
  1.  S %="",DAT=""
  1.  F  S %=$O(INPAR("APPL",%)) Q:'$L(%)  W !,?3,%,?13,$P(INPAR("APPL",%),U) S DAT=DAT_U_%
  1.  S DAT=$E(DAT,2,999)
  1.  W !!
  1.  S %=$$SOC^UTIL("Select Interface Application: ;;;1,8","",DAT,0)
  1.  Q:'$L(%)!(%[U) 0
  1.  S INPAR("APSEL",%)=""
  1.  ;
  1.  Q 1
  1.  ;
  1. APPLAR ;Create array of interface applications
  1.  ;
  1.  K INPAR N L,L2,NA
  1.  F LC=1:1 S L=$P($T(DATA+LC),";;",2,99) Q:'$L(L)  D
  1.  .  ;S L2=$P($T(DATA+(LC+1)),";;",2,99),NA=$P(L,U,2)
  1.  .  S NA=$P(L,U,2),L2="Q"
  1.  .  ;Quit if no routine or no identifier
  1.  .  Q:'$L(L2)!'$L(NA)
  1.  .  S INPAR("APPL",NA)=L
  1.  .  S INPAR("APCO",NA)=L2
  1.  ;action - activate (def)
  1.  S INPAR("ACT")=1
  1.  ;Replicate or Parent - default to parent/child
  1.  S INPAR("REPL")=0
  1.  Q
  1.  ;
  1. DATACOM ;Description of DATA tag
  1.  ;;  format -  ;; interface application name ^  appl indentifier
  1. DATA ;Data
  1.  ;;Anatomic Pathology^AP
  1.  ;;DBSS^BB
  1.  ;;Breast Care Clinic^BCC
  1.  ;;CHCS II^CHCSII
  1.  ;;Clinical Integrated Workstation^CIW
  1.  ;;Clinicomp^CLIN
  1.  ;;CRSP Local^CRSPL
  1.  ;;CRSP Regional^CRSPR
  1.  ;;DINPACS^DINPACS
  1.  ;;HIV Viromed/HIV ABTS Receiver Phase 2^HIV
  1.  ;;Immunization Tracking System EuroCHCS/DEERS^ITS
  1.  ;;DMHRS^DMHRS
  1.  ;;Lab System Interface^LSI
  1.  ;;MDIS^MDIS
  1.  ;;MHCMIS (CEIS)^MHC
  1.  ;;Nutrition Management Interface System^NMIS
  1.  ;;Pacmednet^PMN
  1.  ;;Pharmacy Data Transaction Service^PDTS
  1.  ;;Provider WorkStation^PWS
  1.  ;;TRACES^TRAC
  1.  ;;TRICARE Support Contractor^TSC
  1.  ;;TRICARE Support Contractor Loader^TSCL
  1.  ;;
  1.  ;;Test Functionality^TEST
  1.  ;;Prototype Functionality^PROTO
  1.  ;;