PRCHJS07 ;OI&T/KCL - IFCAP/ECMS INTERFACE RETRANSMIT 2237;6/6/12
;;5.1;IFCAP;**167,174**;Oct 20, 2000;Build 23
;Per VHA Directive 2004-38, this routine should not be modified.
;
ENTACT(PRCDUZ) ;Option [PRCHJ RETRANS 2237] entry action
;This function is called from the entry action of the
;option. If the user is not assigned as the PPM ACCOUNTABLE
;OFFICER or MANAGER, access will be denied.
;
; Input:
; PRCDUZ - (required) IEN of user in the NEW PERSON (#200) file
;
; Output:
; Function value - 1 on success, 0 on failure (access denied)
;
N PRCIENS ;iens string for GETS^DIQ
N PRCFLDS ;results array for GETS^DIQ
N PRCERR ;error array for GETS^DIQ
N PRCRSLT ;function result
;
S PRCRSLT=0
;
I +$G(DUZ)>0 D
. ;is user assigned as PPM ACCOUNTABLE OFFICER or MANAGER?
. S PRCIENS=+$G(DUZ)_","
. D GETS^DIQ(200,PRCIENS,"400","I","PRCFLDS","PRCERR")
. Q:$D(PRCERR)
. I $G(PRCFLDS(200,PRCIENS,400,"I"))=2!($G(PRCFLDS(200,PRCIENS,400,"I"))=4) S PRCRSLT=1
;
I 'PRCRSLT D
. W !!,">>> You are not authorized to use this option!"
. W !?4,"User is not setup as Manager or Accountable Officer."
;
Q PRCRSLT
;
;
RETRANS ;Option [PRCHJ RETRANS 2237] run routine
;This procedure is the run routine for the [PRCHJ RETRANS 2237]
;option and allows retransmission of a 2237 to the Electronic
;Contract Management System (eCMS) via HL7 messaging.
;
; Input: None
; Output: None
;
N PRCESIG ;output from call to ESIG^PRCUESIG
N PRCABORT ;flag to abort user prompting
;
;prompt - electronic signature to validate user
W !
S PRCESIG=""
D ESIG^PRCUESIG($G(DUZ),.PRCESIG)
Q:$G(PRCESIG)'=1
;
;prompt user to retransmit 2237 transactions until PRCABORT=1
S PRCABORT=0
F D Q:PRCABORT
. N PRCER ;transmission error text
. N PRCLOGER ;error returned from LOG^PRCHJTA
. ;prompt - select 2237 transaction in REQUEST WORKSHEET (#443) file
. N DIC,DTOUT,DUOUT,X,Y ;^DIC variables
. N PRCSELCT ;selected entry: ien^transaction #
. W !
. S DIC="^PRC(443,"
. S DIC(0)="AEMQZ"
. S DIC("A")="Select 2237 TRANSACTION NUMBER: "
. ;(screen) only allow selection of 2237s with status of 'Sent to eCMS (P&C)' and
. ;have not been processed by eCMS (no ECMS ACTIONUID)
. S DIC("S")="I $P(^PRC(443,+$G(Y),0),U,7)=69,'$$ECMS2237^PRCHJUTL(Y)"
. D ^DIC K DIC
. S:$G(Y)>0 PRCSELCT=+$G(Y)_U_$G(Y(0,0))
. ;abort if no 2237 transaction selected, or user enters up-arrow, or timed out
. I (Y=-1)!($D(DTOUT))!($D(DUOUT)) S PRCABORT=1 Q
. ;
. ;prompt - review 2237 prior to retransmission?
. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y ;^DIR variables
. W !
. S DIR(0)="YA"
. S DIR("B")="NO"
. S DIR("A")="Would you like to review this 2237 transaction? "
. S DIR("?")="'Yes' to review the 2237 prior to retransmitting, 'No' to not review."
. D ^DIR K DIR
. ;abort if user enters up-arrow, pressed Enter key, or timed out
. I $D(DIRUT) S PRCABORT=1 Q
. ;if Yes, display 2237 for review
. I Y=1 D DISP2237(+$G(PRCSELCT))
. ;
. ;prompt - 2237 retransmit?
. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y ;^DIR variables
. W !
. S DIR(0)="YA"
. S DIR("B")="NO"
. S DIR("A")="Do you want to retransmit this 2237 transaction to eCMS? "
. S DIR("?")="'Yes' to retransmit the 2237 to eCMS, 'No' to not retransmit."
. D ^DIR K DIR
. ;abort if user enters up-arrow, pressed Enter key, or timed out
. I $D(DIRUT) S PRCABORT=1 Q
. ;if No selected, quit and ask user for another 2237 transaction
. I (Y=0) Q
. ;
. ;if Yes selected, retransmit 2237 to eCMS
. W !!,"Retransmitting 2237 transaction to eCMS..."
. N PRCMSGID ;ien of msg in HLO MESSAGES (#778) file
. S PRCMSGID=$$SEND2237^PRCHJS01(+$G(PRCSELCT),.PRCER)
. ;
. ;was the transmission successful, ELSE did it fail?
. I $G(PRCMSGID)>0 D
. . W !?3,">>> 2237 transaction has been successfully retransmitted to eCMS."
. . W !?7,"Transaction Number: "_$P($G(PRCSELCT),U,2)
. . W !?11,"HLO Message ID: "_$G(PRCMSGID)
. . ;log transmission in IFCAP/ECMS TRANSACTION (#414.06) file
. . W !!?3,">>> Updating retransmission in IFCAP/ECMS Transaction file..."
. . N PRCEVNT ;event array for LOG^PRCHJTA
. . S PRCEVNT("MSGID")=$G(PRCMSGID)
. . S PRCEVNT("IEN410")=+$G(PRCSELCT)
. . S PRCEVNT("IFCAPU")=$G(DUZ)
. . D LOG^PRCHJTA($P($G(PRCSELCT),U,2),,4,.PRCEVNT,.PRCLOGER)
. . I +$G(PRCLOGER) W !?7,"Error: "_$P($G(PRCLOGER),U,2)
. E D
. . W !?3,">>> ERROR: 2237 was not retransmitted to eCMS!"
. . W !?7,"Transaction Number: "_$P($G(PRCSELCT),U,2)
. . ;setup PRCEVNT array for call to LOG^PRCHJTA and output error(s)
. . N PRCEVNT
. . S PRCEVNT("MSGID")=""
. . S PRCEVNT("IEN410")=+$G(PRCSELCT)
. . S PRCEVNT("IFCAPU")=$G(DUZ)
. . S PRCEVNT("ERROR",1)="An error occurred when retransmitting the 2237 transaction to eCMS."
. . S PRCEVNT("ERROR",2)="Option: "_$S($P($G(XQY0),"^",2)]"":$P($G(XQY0),"^",2),1:"UNKNOWN")
. . N PRCIDX1,PRCIDX2
. . S PRCIDX1=0,PRCIDX2=2
. . ;output error(s)
. . F S PRCIDX1=$O(PRCER(PRCIDX1)) Q:PRCIDX1="" D
. . . W !?7,"Error #"_$G(PRCIDX1)_": "_$G(PRCER(PRCIDX1))
. . . S PRCIDX2=PRCIDX2+1 S PRCEVNT("ERROR",PRCIDX2)="Error #"_$G(PRCIDX1)_": "_$G(PRCER(PRCIDX1))
. . W !!?3,">>> Updating transmission error in IFCAP/ECMS Transaction file..."
. . D LOG^PRCHJTA($P($G(PRCSELCT),U,2),,4,.PRCEVNT,.PRCLOGER)
. . I +$G(PRCLOGER) W !?7,"Error: "_$P($G(PRCLOGER),U,2)
. . ;send error(s) to AO
. . W !!?3,">>> Sending error notification mail message to Accountable Officer..."
. . N PRCMSG1,PRCMSG2 ;input arrays for PHMSG^PRCHJMSG, pass by ref
. . S PRCMSG1(1)=$P($G(PRCSELCT),U,2)
. . S PRCMSG1(2)=5 ;return to AO since failed transmission to eCMS
. . S PRCMSG1(3)=$$NOW^XLFDT ;action date/time
. . S PRCMSG1(7)="Please forward this message to appropriate OIT staff!"
. . M PRCMSG2=PRCEVNT("ERROR") ;merge error array into PRCMSG2 array
. . D PHMSG^PRCHJMSG(.PRCMSG1,.PRCMSG2) ;send msg
. ;
. ;prompt - retransmit another 2237 transaction?
. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y ;^DIR variables
. S DIR(0)="YA"
. S DIR("B")="NO"
. S DIR("A")="Do you want to retransmit another 2237 transaction to eCMS? "
. S DIR("?")="'Yes' to retransmit another 2237 to eCMS, 'No' to exit."
. W !
. D ^DIR K DIR
. ;abort if user enters No, up-arrow, pressed Enter key, or timed out
. I $D(DIRUT)!(Y=0) S PRCABORT=1 Q
;
Q
;
;
DISP2237(DA) ;Display 2237 Utility
;This procedure calls ^PRCSD12 to display a 2237 to the screen.
;
; Input:
; DA - (required var for ^PRCSD12) IEN of record in CONTROL POINT ACTIVITY (#410) file
;
; Output: None
;
N PRCS,PRCPRIB,TRNODE
S (PRCS,PRCPRIB)=$G(DA)
S TRNODE(0)=0
D ^PRCSD12
Q
;
;
CONTINUE() ;Pause display utility
;This function is used to pause the display and prompt the
;user to --> Enter RETURN to continue or '^' to exit
;
; Input: None
;
; Output: 1 - continue
; 0 - quit/exit
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y ;^DIR variables
S DIR(0)="E"
D ^DIR K DIR
Q $S(Y'=1:0,1:1)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHJS07 7089 printed Oct 16, 2024@18:09:04 Page 2
PRCHJS07 ;OI&T/KCL - IFCAP/ECMS INTERFACE RETRANSMIT 2237;6/6/12
+1 ;;5.1;IFCAP;**167,174**;Oct 20, 2000;Build 23
+2 ;Per VHA Directive 2004-38, this routine should not be modified.
+3 ;
ENTACT(PRCDUZ) ;Option [PRCHJ RETRANS 2237] entry action
+1 ;This function is called from the entry action of the
+2 ;option. If the user is not assigned as the PPM ACCOUNTABLE
+3 ;OFFICER or MANAGER, access will be denied.
+4 ;
+5 ; Input:
+6 ; PRCDUZ - (required) IEN of user in the NEW PERSON (#200) file
+7 ;
+8 ; Output:
+9 ; Function value - 1 on success, 0 on failure (access denied)
+10 ;
+11 ;iens string for GETS^DIQ
NEW PRCIENS
+12 ;results array for GETS^DIQ
NEW PRCFLDS
+13 ;error array for GETS^DIQ
NEW PRCERR
+14 ;function result
NEW PRCRSLT
+15 ;
+16 SET PRCRSLT=0
+17 ;
+18 IF +$GET(DUZ)>0
Begin DoDot:1
+19 ;is user assigned as PPM ACCOUNTABLE OFFICER or MANAGER?
+20 SET PRCIENS=+$GET(DUZ)_","
+21 DO GETS^DIQ(200,PRCIENS,"400","I","PRCFLDS","PRCERR")
+22 if $DATA(PRCERR)
QUIT
+23 IF $GET(PRCFLDS(200,PRCIENS,400,"I"))=2!($GET(PRCFLDS(200,PRCIENS,400,"I"))=4)
SET PRCRSLT=1
End DoDot:1
+24 ;
+25 IF 'PRCRSLT
Begin DoDot:1
+26 WRITE !!,">>> You are not authorized to use this option!"
+27 WRITE !?4,"User is not setup as Manager or Accountable Officer."
End DoDot:1
+28 ;
+29 QUIT PRCRSLT
+30 ;
+31 ;
RETRANS ;Option [PRCHJ RETRANS 2237] run routine
+1 ;This procedure is the run routine for the [PRCHJ RETRANS 2237]
+2 ;option and allows retransmission of a 2237 to the Electronic
+3 ;Contract Management System (eCMS) via HL7 messaging.
+4 ;
+5 ; Input: None
+6 ; Output: None
+7 ;
+8 ;output from call to ESIG^PRCUESIG
NEW PRCESIG
+9 ;flag to abort user prompting
NEW PRCABORT
+10 ;
+11 ;prompt - electronic signature to validate user
+12 WRITE !
+13 SET PRCESIG=""
+14 DO ESIG^PRCUESIG($GET(DUZ),.PRCESIG)
+15 if $GET(PRCESIG)'=1
QUIT
+16 ;
+17 ;prompt user to retransmit 2237 transactions until PRCABORT=1
+18 SET PRCABORT=0
+19 FOR
Begin DoDot:1
+20 ;transmission error text
NEW PRCER
+21 ;error returned from LOG^PRCHJTA
NEW PRCLOGER
+22 ;prompt - select 2237 transaction in REQUEST WORKSHEET (#443) file
+23 ;^DIC variables
NEW DIC,DTOUT,DUOUT,X,Y
+24 ;selected entry: ien^transaction #
NEW PRCSELCT
+25 WRITE !
+26 SET DIC="^PRC(443,"
+27 SET DIC(0)="AEMQZ"
+28 SET DIC("A")="Select 2237 TRANSACTION NUMBER: "
+29 ;(screen) only allow selection of 2237s with status of 'Sent to eCMS (P&C)' and
+30 ;have not been processed by eCMS (no ECMS ACTIONUID)
+31 SET DIC("S")="I $P(^PRC(443,+$G(Y),0),U,7)=69,'$$ECMS2237^PRCHJUTL(Y)"
+32 DO ^DIC
KILL DIC
+33 if $GET(Y)>0
SET PRCSELCT=+$GET(Y)_U_$GET(Y(0,0))
+34 ;abort if no 2237 transaction selected, or user enters up-arrow, or timed out
+35 IF (Y=-1)!($DATA(DTOUT))!($DATA(DUOUT))
SET PRCABORT=1
QUIT
+36 ;
+37 ;prompt - review 2237 prior to retransmission?
+38 ;^DIR variables
NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+39 WRITE !
+40 SET DIR(0)="YA"
+41 SET DIR("B")="NO"
+42 SET DIR("A")="Would you like to review this 2237 transaction? "
+43 SET DIR("?")="'Yes' to review the 2237 prior to retransmitting, 'No' to not review."
+44 DO ^DIR
KILL DIR
+45 ;abort if user enters up-arrow, pressed Enter key, or timed out
+46 IF $DATA(DIRUT)
SET PRCABORT=1
QUIT
+47 ;if Yes, display 2237 for review
+48 IF Y=1
DO DISP2237(+$GET(PRCSELCT))
+49 ;
+50 ;prompt - 2237 retransmit?
+51 ;^DIR variables
NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+52 WRITE !
+53 SET DIR(0)="YA"
+54 SET DIR("B")="NO"
+55 SET DIR("A")="Do you want to retransmit this 2237 transaction to eCMS? "
+56 SET DIR("?")="'Yes' to retransmit the 2237 to eCMS, 'No' to not retransmit."
+57 DO ^DIR
KILL DIR
+58 ;abort if user enters up-arrow, pressed Enter key, or timed out
+59 IF $DATA(DIRUT)
SET PRCABORT=1
QUIT
+60 ;if No selected, quit and ask user for another 2237 transaction
+61 IF (Y=0)
QUIT
+62 ;
+63 ;if Yes selected, retransmit 2237 to eCMS
+64 WRITE !!,"Retransmitting 2237 transaction to eCMS..."
+65 ;ien of msg in HLO MESSAGES (#778) file
NEW PRCMSGID
+66 SET PRCMSGID=$$SEND2237^PRCHJS01(+$GET(PRCSELCT),.PRCER)
+67 ;
+68 ;was the transmission successful, ELSE did it fail?
+69 IF $GET(PRCMSGID)>0
Begin DoDot:2
+70 WRITE !?3,">>> 2237 transaction has been successfully retransmitted to eCMS."
+71 WRITE !?7,"Transaction Number: "_$PIECE($GET(PRCSELCT),U,2)
+72 WRITE !?11,"HLO Message ID: "_$GET(PRCMSGID)
+73 ;log transmission in IFCAP/ECMS TRANSACTION (#414.06) file
+74 WRITE !!?3,">>> Updating retransmission in IFCAP/ECMS Transaction file..."
+75 ;event array for LOG^PRCHJTA
NEW PRCEVNT
+76 SET PRCEVNT("MSGID")=$GET(PRCMSGID)
+77 SET PRCEVNT("IEN410")=+$GET(PRCSELCT)
+78 SET PRCEVNT("IFCAPU")=$GET(DUZ)
+79 DO LOG^PRCHJTA($PIECE($GET(PRCSELCT),U,2),,4,.PRCEVNT,.PRCLOGER)
+80 IF +$GET(PRCLOGER)
WRITE !?7,"Error: "_$PIECE($GET(PRCLOGER),U,2)
End DoDot:2
+81 IF '$TEST
Begin DoDot:2
+82 WRITE !?3,">>> ERROR: 2237 was not retransmitted to eCMS!"
+83 WRITE !?7,"Transaction Number: "_$PIECE($GET(PRCSELCT),U,2)
+84 ;setup PRCEVNT array for call to LOG^PRCHJTA and output error(s)
+85 NEW PRCEVNT
+86 SET PRCEVNT("MSGID")=""
+87 SET PRCEVNT("IEN410")=+$GET(PRCSELCT)
+88 SET PRCEVNT("IFCAPU")=$GET(DUZ)
+89 SET PRCEVNT("ERROR",1)="An error occurred when retransmitting the 2237 transaction to eCMS."
+90 SET PRCEVNT("ERROR",2)="Option: "_$SELECT($PIECE($GET(XQY0),"^",2)]"":$PIECE($GET(XQY0),"^",2),1:"UNKNOWN")
+91 NEW PRCIDX1,PRCIDX2
+92 SET PRCIDX1=0
SET PRCIDX2=2
+93 ;output error(s)
+94 FOR
SET PRCIDX1=$ORDER(PRCER(PRCIDX1))
if PRCIDX1=""
QUIT
Begin DoDot:3
+95 WRITE !?7,"Error #"_$GET(PRCIDX1)_": "_$GET(PRCER(PRCIDX1))
+96 SET PRCIDX2=PRCIDX2+1
SET PRCEVNT("ERROR",PRCIDX2)="Error #"_$GET(PRCIDX1)_": "_$GET(PRCER(PRCIDX1))
End DoDot:3
+97 WRITE !!?3,">>> Updating transmission error in IFCAP/ECMS Transaction file..."
+98 DO LOG^PRCHJTA($PIECE($GET(PRCSELCT),U,2),,4,.PRCEVNT,.PRCLOGER)
+99 IF +$GET(PRCLOGER)
WRITE !?7,"Error: "_$PIECE($GET(PRCLOGER),U,2)
+100 ;send error(s) to AO
+101 WRITE !!?3,">>> Sending error notification mail message to Accountable Officer..."
+102 ;input arrays for PHMSG^PRCHJMSG, pass by ref
NEW PRCMSG1,PRCMSG2
+103 SET PRCMSG1(1)=$PIECE($GET(PRCSELCT),U,2)
+104 ;return to AO since failed transmission to eCMS
SET PRCMSG1(2)=5
+105 ;action date/time
SET PRCMSG1(3)=$$NOW^XLFDT
+106 SET PRCMSG1(7)="Please forward this message to appropriate OIT staff!"
+107 ;merge error array into PRCMSG2 array
MERGE PRCMSG2=PRCEVNT("ERROR")
+108 ;send msg
DO PHMSG^PRCHJMSG(.PRCMSG1,.PRCMSG2)
End DoDot:2
+109 ;
+110 ;prompt - retransmit another 2237 transaction?
+111 ;^DIR variables
NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+112 SET DIR(0)="YA"
+113 SET DIR("B")="NO"
+114 SET DIR("A")="Do you want to retransmit another 2237 transaction to eCMS? "
+115 SET DIR("?")="'Yes' to retransmit another 2237 to eCMS, 'No' to exit."
+116 WRITE !
+117 DO ^DIR
KILL DIR
+118 ;abort if user enters No, up-arrow, pressed Enter key, or timed out
+119 IF $DATA(DIRUT)!(Y=0)
SET PRCABORT=1
QUIT
End DoDot:1
if PRCABORT
QUIT
+120 ;
+121 QUIT
+122 ;
+123 ;
DISP2237(DA) ;Display 2237 Utility
+1 ;This procedure calls ^PRCSD12 to display a 2237 to the screen.
+2 ;
+3 ; Input:
+4 ; DA - (required var for ^PRCSD12) IEN of record in CONTROL POINT ACTIVITY (#410) file
+5 ;
+6 ; Output: None
+7 ;
+8 NEW PRCS,PRCPRIB,TRNODE
+9 SET (PRCS,PRCPRIB)=$GET(DA)
+10 SET TRNODE(0)=0
+11 DO ^PRCSD12
+12 QUIT
+13 ;
+14 ;
CONTINUE() ;Pause display utility
+1 ;This function is used to pause the display and prompt the
+2 ;user to --> Enter RETURN to continue or '^' to exit
+3 ;
+4 ; Input: None
+5 ;
+6 ; Output: 1 - continue
+7 ; 0 - quit/exit
+8 ;
+9 ;^DIR variables
NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+10 SET DIR(0)="E"
+11 DO ^DIR
KILL DIR
+12 QUIT $SELECT(Y'=1:0,1:1)
