INHPSAL1 ;KN; 16 Apr 96 14:42; MFN Loader Activates Software Application
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
Q
;
PROCINT(INTER,INPAR,INNAME,INDATA,INMESS) ;Process one interface
;This is called as the control routine for most interfaces
;Called from PROC^INHPSAL
;INPUT:
; INTER - interface application identifier
; INPAR - array of parameters
; INNAME - name of application
; INDATA - executable MUMPS code to get data array
; should leave data in the array INDAT
; INMESS - executable code to be done after the load is complete
;
S INNAME=$G(INNAME),INTER=$G(INTER),INDATA=$G(INDATA),INMESS=$G(INMESS)
Q:'$L(INTER) 0
N INERR,INDAT
S INERR=""
;Get default name
S:'$L(INNAME) INNAME=$P($G(INPAR("APPL",INTER)),U)
;Create array of data for application
K INDAT
;Check for custom defined data builder code
I $L(INDATA) X INDATA I INERR W !,"ERROR: ",INNAME," - no action taken" S INERR=1 Q 0
;Execute standard data builder
I '$L(INDATA) I '$$CREDAT(.INDAT) W !,"ERROR: Unable to create data array." S INERR=1 Q 0
;Process application
W !!,"Processing ",INNAME
D TT(INTER,.INDAT,.INPAR)
;Quit positive if no errors, null if errors encoutnered
Q $S('INERR:1,1:0)
;
TT(INTER,INDAT,INPAR) ;Transaction Types
;
;Process Transaction Type
N INREC S INREC=0
F S INREC=$O(INDAT(INTER,4000,INREC)) Q:'INREC S:'$$TTONE(INREC,+$G(INPAR("ACT"))) INERR=1
;
Q
;
TTONE(DA,INST) ;Process one transaction type
;
N DIC,X,Y,DIE,DR,INSTMSG,INNAME
S INST=+$G(INST)
;Quit if deactivating and suppress deactivation flag is set
Q:'INST&$P($G(INDAT(INTER,4000,DA)),U,2) 1
;Quit if activating and suppress activation flag is set
Q:INST&$P($G(INDAT(INTER,4000,DA)),U,3) 1
S (INNAME,X)=$P($G(INDAT(INTER,4000,DA)),U,1),DIC=4000,DIC(0)="",Y=$$DIC^INHPSA(DIC,X,"",DIC(0)),DA=+Y
I INNAME'=$P(Y,U,2) W !,"ERROR: Wanted transaction type ",INNAME," but found ",$P(Y,U,2)," (",+Y,")." Q 0
I DA<0 W !,"ERROR: Transaction Type: ",INNAME," not found." Q 0
; Deactivate all the active children except the calling child
Q:'$$TTCHILD(DA,INST) 0
; Set the destination according to user selection
Q:'$$DSTEDT(DA,INST) 0
;
Q 1
;
TTCHILD(DA,INST) ;Deactivate all child transaction types except for
; the one selected by user
;DA - ien of child transaction type selected
;
N INCHTT,INPATT
;find the parent of calling child INPATT
S INCHTT=+DA,INPATT=+$P(^INRHT(DA,0),U,6)
;loop through all the children of this parent
S TT="" F S TT=$O(^INRHT("AC",INPATT,TT)) Q:'TT D
.; in case of not a calling child
. I TT'=DA D
..; check if it is active, then deactivate it
.. I $P($G(^INRHT(TT,0)),U,5) D
... Q:'$$TTEDT^INHPSA(TT,0)
. E D
..; in case the calling child is not active, then activate it
.. I '$P(^INRHT(TT,0),U,5) Q:'$$TTEDT^INHPSA(TT,1)
Q 1
;
DSTEDT(DA,INST) ;Edit destination
;
N INTMP,INNEW,INNIEN
;INTMP is current destination ien
;INNEW is new destination the user want to change
;INNIEN is the new destination ien
S INTMP=$P(^INRHT(DA,0),U,2),INNIEN=$G(INPAR("DESTIEN")),INNEW=$P(^INRHD(INNIEN,0),U,2)
;change the destination
S DIE=4000,DR=".02///`"_INNIEN D ^DIE
Q 1
;
CREDAT(INDAT) ;Create data array of control records
;
N INERR,L1,TXT S INERR=1
;Load data into array
F LI=1:1 S TXT=$P($$TEXT^INHPSAL2(INTER,LI),";;",2,99) Q:'TXT I '$$LOAD^INHPSA(.INDAT,TXT,INTER) S INERR=0
Q INERR
;
INHPSAL1 ;KN; 16 Apr 96 14:42; MFN Loader Activates Software Application
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 QUIT
+5 ;
PROCINT(INTER,INPAR,INNAME,INDATA,INMESS) ;Process one interface
+1 ;This is called as the control routine for most interfaces
+2 ;Called from PROC^INHPSAL
+3 ;INPUT:
+4 ; INTER - interface application identifier
+5 ; INPAR - array of parameters
+6 ; INNAME - name of application
+7 ; INDATA - executable MUMPS code to get data array
+8 ; should leave data in the array INDAT
+9 ; INMESS - executable code to be done after the load is complete
+10 ;
+11 SET INNAME=$GET(INNAME)
SET INTER=$GET(INTER)
SET INDATA=$GET(INDATA)
SET INMESS=$GET(INMESS)
+12 IF '$LENGTH(INTER)
QUIT 0
+13 NEW INERR,INDAT
+14 SET INERR=""
+15 ;Get default name
+16 IF '$LENGTH(INNAME)
SET INNAME=$PIECE($GET(INPAR("APPL",INTER)),U)
+17 ;Create array of data for application
+18 KILL INDAT
+19 ;Check for custom defined data builder code
+20 IF $LENGTH(INDATA)
XECUTE INDATA
IF INERR
WRITE !,"ERROR: ",INNAME," - no action taken"
SET INERR=1
QUIT 0
+21 ;Execute standard data builder
+22 IF '$LENGTH(INDATA)
IF '$$CREDAT(.INDAT)
WRITE !,"ERROR: Unable to create data array."
SET INERR=1
QUIT 0
+23 ;Process application
+24 WRITE !!,"Processing ",INNAME
+25 DO TT(INTER,.INDAT,.INPAR)
+26 ;Quit positive if no errors, null if errors encoutnered
+27 QUIT $SELECT('INERR:1,1:0)
+28 ;
TT(INTER,INDAT,INPAR) ;Transaction Types
+1 ;
+2 ;Process Transaction Type
+3 NEW INREC
SET INREC=0
+4 FOR
SET INREC=$ORDER(INDAT(INTER,4000,INREC))
IF 'INREC
QUIT
IF '$$TTONE(INREC,+$GET(INPAR("ACT")))
SET INERR=1
+5 ;
+6 QUIT
+7 ;
TTONE(DA,INST) ;Process one transaction type
+1 ;
+2 NEW DIC,X,Y,DIE,DR,INSTMSG,INNAME
+3 SET INST=+$GET(INST)
+4 ;Quit if deactivating and suppress deactivation flag is set
+5 IF 'INST&$PIECE($GET(INDAT(INTER,4000,DA)),U,2)
QUIT 1
+6 ;Quit if activating and suppress activation flag is set
+7 IF INST&$PIECE($GET(INDAT(INTER,4000,DA)),U,3)
QUIT 1
+8 SET (INNAME,X)=$PIECE($GET(INDAT(INTER,4000,DA)),U,1)
SET DIC=4000
SET DIC(0)=""
SET Y=$$DIC^INHPSA(DIC,X,"",DIC(0))
SET DA=+Y
+9 IF INNAME'=$PIECE(Y,U,2)
WRITE !,"ERROR: Wanted transaction type ",INNAME," but found ",$PIECE(Y,U,2)," (",+Y,")."
QUIT 0
+10 IF DA<0
WRITE !,"ERROR: Transaction Type: ",INNAME," not found."
QUIT 0
+11 ; Deactivate all the active children except the calling child
+12 IF '$$TTCHILD(DA,INST)
QUIT 0
+13 ; Set the destination according to user selection
+14 IF '$$DSTEDT(DA,INST)
QUIT 0
+15 ;
+16 QUIT 1
+17 ;
TTCHILD(DA,INST) ;Deactivate all child transaction types except for
+1 ; the one selected by user
+2 ;DA - ien of child transaction type selected
+3 ;
+4 NEW INCHTT,INPATT
+5 ;find the parent of calling child INPATT
+6 SET INCHTT=+DA
SET INPATT=+$PIECE(^INRHT(DA,0),U,6)
+7 ;loop through all the children of this parent
+8 SET TT=""
FOR
SET TT=$ORDER(^INRHT("AC",INPATT,TT))
IF 'TT
QUIT
Begin DoDot:1
+9 ; in case of not a calling child
+10 IF TT'=DA
Begin DoDot:2
+11 ; check if it is active, then deactivate it
+12 IF $PIECE($GET(^INRHT(TT,0)),U,5)
Begin DoDot:3
+13 IF '$$TTEDT^INHPSA(TT,0)
QUIT
End DoDot:3
End DoDot:2
+14 IF '$TEST
Begin DoDot:2
+15 ; in case the calling child is not active, then activate it
+16 IF '$PIECE(^INRHT(TT,0),U,5)
IF '$$TTEDT^INHPSA(TT,1)
QUIT
End DoDot:2
End DoDot:1
+17 QUIT 1
+18 ;
DSTEDT(DA,INST) ;Edit destination
+1 ;
+2 NEW INTMP,INNEW,INNIEN
+3 ;INTMP is current destination ien
+4 ;INNEW is new destination the user want to change
+5 ;INNIEN is the new destination ien
+6 SET INTMP=$PIECE(^INRHT(DA,0),U,2)
SET INNIEN=$GET(INPAR("DESTIEN"))
SET INNEW=$PIECE(^INRHD(INNIEN,0),U,2)
+7 ;change the destination
+8 SET DIE=4000
SET DR=".02///`"_INNIEN
DO ^DIE
+9 QUIT 1
+10 ;
CREDAT(INDAT) ;Create data array of control records
+1 ;
+2 NEW INERR,L1,TXT
SET INERR=1
+3 ;Load data into array
+4 FOR LI=1:1
SET TXT=$PIECE($$TEXT^INHPSAL2(INTER,LI),";;",2,99)
IF 'TXT
QUIT
IF '$$LOAD^INHPSA(.INDAT,TXT,INTER)
SET INERR=0
+5 QUIT INERR
+6 ;
