- 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 ;
