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

PRCHJS07.m

Go to the documentation of this file. 
  1. PRCHJS07 ;OI&T/KCL - IFCAP/ECMS INTERFACE RETRANSMIT 2237;6/6/12
  1.  ;;5.1;IFCAP;**167,174**;Oct 20, 2000;Build 23
  1.  ;Per VHA Directive 2004-38, this routine should not be modified.
  1.  ;
  1. ENTACT(PRCDUZ) ;Option [PRCHJ RETRANS 2237] entry action 
  1.  ;This function is called from the entry action of the
  1.  ;option. If the user is not assigned as the PPM ACCOUNTABLE
  1.  ;OFFICER or MANAGER, access will be denied.
  1.  ;
  1.  ;  Input:
  1.  ;   PRCDUZ - (required) IEN of user in the NEW PERSON (#200) file
  1.  ;
  1.  ; Output:
  1.  ;   Function value - 1 on success, 0 on failure (access denied)
  1.  ;
  1.  N PRCIENS ;iens string for GETS^DIQ
  1.  N PRCFLDS ;results array for GETS^DIQ
  1.  N PRCERR  ;error array for GETS^DIQ
  1.  N PRCRSLT ;function result
  1.  ;
  1.  S PRCRSLT=0
  1.  ;
  1.  I +$G(DUZ)>0 D
  1.  . ;is user assigned as PPM ACCOUNTABLE OFFICER or MANAGER?
  1.  . S PRCIENS=+$G(DUZ)_","
  1.  . D GETS^DIQ(200,PRCIENS,"400","I","PRCFLDS","PRCERR")
  1.  . Q:$D(PRCERR)
  1.  . I $G(PRCFLDS(200,PRCIENS,400,"I"))=2!($G(PRCFLDS(200,PRCIENS,400,"I"))=4) S PRCRSLT=1
  1.  ;
  1.  I 'PRCRSLT D
  1.  . W !!,">>> You are not authorized to use this option!"
  1.  . W !?4,"User is not setup as Manager or Accountable Officer."
  1.  ;
  1.  Q PRCRSLT
  1.  ;
  1.  ;
  1. RETRANS ;Option [PRCHJ RETRANS 2237] run routine 
  1.  ;This procedure is the run routine for the [PRCHJ RETRANS 2237]
  1.  ;option and allows retransmission of a 2237 to the Electronic
  1.  ;Contract Management System (eCMS) via HL7 messaging.
  1.  ;
  1.  ;  Input: None
  1.  ; Output: None
  1.  ;
  1.  N PRCESIG  ;output from call to ESIG^PRCUESIG
  1.  N PRCABORT ;flag to abort user prompting
  1.  ;
  1.  ;prompt - electronic signature to validate user
  1.  W !
  1.  S PRCESIG=""
  1.  D ESIG^PRCUESIG($G(DUZ),.PRCESIG)
  1.  Q:$G(PRCESIG)'=1
  1.  ;
  1.  ;prompt user to retransmit 2237 transactions until PRCABORT=1
  1.  S PRCABORT=0
  1.  F  D  Q:PRCABORT
  1.  . N PRCER    ;transmission error text
  1.  . N PRCLOGER ;error returned from LOG^PRCHJTA
  1.  . ;prompt - select 2237 transaction in REQUEST WORKSHEET (#443) file
  1.  . N DIC,DTOUT,DUOUT,X,Y ;^DIC variables
  1.  . N PRCSELCT ;selected entry: ien^transaction #
  1.  . W !
  1.  . S DIC="^PRC(443,"
  1.  . S DIC(0)="AEMQZ"
  1.  . S DIC("A")="Select 2237 TRANSACTION NUMBER: "
  1.  . ;(screen) only allow selection of 2237s with status of 'Sent to eCMS (P&C)' and
  1.  . ;have not been processed by eCMS (no ECMS ACTIONUID)
  1.  . S DIC("S")="I $P(^PRC(443,+$G(Y),0),U,7)=69,'$$ECMS2237^PRCHJUTL(Y)"
  1.  . D ^DIC K DIC
  1.  . S:$G(Y)>0 PRCSELCT=+$G(Y)_U_$G(Y(0,0))
  1.  . ;abort if no 2237 transaction selected, or user enters up-arrow, or timed out
  1.  . I (Y=-1)!($D(DTOUT))!($D(DUOUT)) S PRCABORT=1 Q
  1.  . ;
  1.  . ;prompt - review 2237 prior to retransmission?
  1.  . N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y ;^DIR variables
  1.  . W !
  1.  . S DIR(0)="YA"
  1.  . S DIR("B")="NO"
  1.  . S DIR("A")="Would you like to review this 2237 transaction? "
  1.  . S DIR("?")="'Yes' to review the 2237 prior to retransmitting, 'No' to not review."
  1.  . D ^DIR K DIR
  1.  . ;abort if user enters up-arrow, pressed Enter key, or timed out
  1.  . I $D(DIRUT) S PRCABORT=1 Q
  1.  . ;if Yes, display 2237 for review
  1.  . I Y=1 D DISP2237(+$G(PRCSELCT))
  1.  . ;
  1.  . ;prompt - 2237 retransmit?
  1.  . N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y ;^DIR variables
  1.  . W !
  1.  . S DIR(0)="YA"
  1.  . S DIR("B")="NO"
  1.  . S DIR("A")="Do you want to retransmit this 2237 transaction to eCMS? "
  1.  . S DIR("?")="'Yes' to retransmit the 2237 to eCMS, 'No' to not retransmit."
  1.  . D ^DIR K DIR
  1.  . ;abort if user enters up-arrow, pressed Enter key, or timed out
  1.  . I $D(DIRUT) S PRCABORT=1 Q
  1.  . ;if No selected, quit and ask user for another 2237 transaction
  1.  . I (Y=0) Q
  1.  . ;
  1.  . ;if Yes selected, retransmit 2237 to eCMS
  1.  . W !!,"Retransmitting 2237 transaction to eCMS..."
  1.  . N PRCMSGID ;ien of msg in HLO MESSAGES (#778) file
  1.  . S PRCMSGID=$$SEND2237^PRCHJS01(+$G(PRCSELCT),.PRCER)
  1.  . ;
  1.  . ;was the transmission successful, ELSE did it fail?
  1.  . I $G(PRCMSGID)>0 D
  1.  . . W !?3,">>> 2237 transaction has been successfully retransmitted to eCMS."
  1.  . . W !?7,"Transaction Number: "_$P($G(PRCSELCT),U,2)
  1.  . . W !?11,"HLO Message ID: "_$G(PRCMSGID)
  1.  . . ;log transmission in IFCAP/ECMS TRANSACTION (#414.06) file
  1.  . . W !!?3,">>> Updating retransmission in IFCAP/ECMS Transaction file..."
  1.  . . N PRCEVNT ;event array for LOG^PRCHJTA
  1.  . . S PRCEVNT("MSGID")=$G(PRCMSGID)
  1.  . . S PRCEVNT("IEN410")=+$G(PRCSELCT)
  1.  . . S PRCEVNT("IFCAPU")=$G(DUZ)
  1.  . . D LOG^PRCHJTA($P($G(PRCSELCT),U,2),,4,.PRCEVNT,.PRCLOGER)
  1.  . . I +$G(PRCLOGER) W !?7,"Error: "_$P($G(PRCLOGER),U,2)
  1.  . E  D
  1.  . . W !?3,">>> ERROR: 2237 was not retransmitted to eCMS!"
  1.  . . W !?7,"Transaction Number: "_$P($G(PRCSELCT),U,2)
  1.  . . ;setup PRCEVNT array for call to LOG^PRCHJTA and output error(s)
  1.  . . N PRCEVNT
  1.  . . S PRCEVNT("MSGID")=""
  1.  . . S PRCEVNT("IEN410")=+$G(PRCSELCT)
  1.  . . S PRCEVNT("IFCAPU")=$G(DUZ)
  1.  . . S PRCEVNT("ERROR",1)="An error occurred when retransmitting the 2237 transaction to eCMS."
  1.  . . S PRCEVNT("ERROR",2)="Option: "_$S($P($G(XQY0),"^",2)]"":$P($G(XQY0),"^",2),1:"UNKNOWN")
  1.  . . N PRCIDX1,PRCIDX2
  1.  . . S PRCIDX1=0,PRCIDX2=2
  1.  . . ;output error(s)
  1.  . . F  S PRCIDX1=$O(PRCER(PRCIDX1)) Q:PRCIDX1=""  D
  1.  . . . W !?7,"Error #"_$G(PRCIDX1)_": "_$G(PRCER(PRCIDX1))
  1.  . . . S PRCIDX2=PRCIDX2+1 S PRCEVNT("ERROR",PRCIDX2)="Error #"_$G(PRCIDX1)_": "_$G(PRCER(PRCIDX1))
  1.  . . W !!?3,">>> Updating transmission error in IFCAP/ECMS Transaction file..."
  1.  . . D LOG^PRCHJTA($P($G(PRCSELCT),U,2),,4,.PRCEVNT,.PRCLOGER)
  1.  . . I +$G(PRCLOGER) W !?7,"Error: "_$P($G(PRCLOGER),U,2)
  1.  . . ;send error(s) to AO
  1.  . . W !!?3,">>> Sending error notification mail message to Accountable Officer..."
  1.  . . N PRCMSG1,PRCMSG2 ;input arrays for PHMSG^PRCHJMSG, pass by ref
  1.  . . S PRCMSG1(1)=$P($G(PRCSELCT),U,2)
  1.  . . S PRCMSG1(2)=5 ;return to AO since failed transmission to eCMS
  1.  . . S PRCMSG1(3)=$$NOW^XLFDT ;action date/time
  1.  . . S PRCMSG1(7)="Please forward this message to appropriate OIT staff!"
  1.  . . M PRCMSG2=PRCEVNT("ERROR") ;merge error array into PRCMSG2 array
  1.  . . D PHMSG^PRCHJMSG(.PRCMSG1,.PRCMSG2) ;send msg
  1.  . ;
  1.  . ;prompt - retransmit another 2237 transaction?
  1.  . N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y ;^DIR variables
  1.  . S DIR(0)="YA"
  1.  . S DIR("B")="NO"
  1.  . S DIR("A")="Do you want to retransmit another 2237 transaction to eCMS? "
  1.  . S DIR("?")="'Yes' to retransmit another 2237 to eCMS, 'No' to exit."
  1.  . W !
  1.  . D ^DIR K DIR
  1.  . ;abort if user enters No, up-arrow, pressed Enter key, or timed out
  1.  . I $D(DIRUT)!(Y=0) S PRCABORT=1 Q
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. DISP2237(DA) ;Display 2237 Utility
  1.  ;This procedure calls ^PRCSD12 to display a 2237 to the screen.
  1.  ;
  1.  ;  Input:
  1.  ;   DA - (required var for ^PRCSD12) IEN of record in CONTROL POINT ACTIVITY (#410) file
  1.  ;
  1.  ; Output: None 
  1.  ; 
  1.  N PRCS,PRCPRIB,TRNODE
  1.  S (PRCS,PRCPRIB)=$G(DA)
  1.  S TRNODE(0)=0
  1.  D ^PRCSD12
  1.  Q
  1.  ;
  1.  ;
  1. CONTINUE() ;Pause display utility
  1.  ;This function is used to pause the display and prompt the 
  1.  ;user to --> Enter RETURN to continue or '^' to exit
  1.  ;
  1.  ;  Input: None
  1.  ;
  1.  ; Output: 1 - continue
  1.  ;         0 - quit/exit
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y ;^DIR variables
  1.  S DIR(0)="E"
  1.  D ^DIR K DIR
  1.  Q $S(Y'=1:0,1:1)