PRCHJRP6 ;OI&T/DDA - Transaction Report from 414.06 [CONT.] ;5/21/13 13:48
V ;;5.1;IFCAP;**174**;Oct 20,2000;Build 23
;Per VHA Directive 2004-38, this routine should not be modified.
;
Q
GATHER ;
K ^TMP("PRCHJRP6",$J)
N CHECKED,NODE0,NODE1,NODE2,NODEHALF,DIR,Y
N PRC2237,PRCACKER,PRCEDT,PRCEDTX,PRCEVENT,PRCEVTX,PRCEXIT,PRCI,PRCPAGE,PRCRUNDT,PRCSTN
N PRCH37,PRCHAND,PRCHCNT,PRCHCTYP,PRCHEDT,PRCHEIEN,PRCHERCT,PRCHERR,PRCHESTN,PRCHEVNT,PRCHEVT,PRCHIEN,PRCHKFCP,PRCHKSTN,PRCHLPDT,PRCHSDT,PRCHSDTX,PRCHSHKE,PRCHSEI,PRCHSI,PRCHSNGL
S PRCHSNGL=0,PRCH37=PRCH2237
; Build the handshake events for those primary events selected.
I PRCH2237="ALL" D
. I $G(PRCHTYPE)'="ALL" D
..; Include RESENT (4) to be equal to SEND (1) event
.. S PRCHAND=",",PRCHTYPE=","_PRCHTYPE
.. S:PRCHTYPE[",1," PRCHAND=PRCHAND_"2,",PRCHTYPE=",1,4,"_$P(PRCHTYPE,",1,",2)
.. S:PRCHTYPE[",6," PRCHAND=PRCHAND_"7,"
.. S:PRCHTYPE[",8," PRCHAND=PRCHAND_"9,"
.. S:PRCHTYPE[",10," PRCHAND=PRCHAND_"11,"
..Q
. I PRCHTYPE="ALL" S PRCHTYPE=",1,4,6,8,10,",PRCHAND=",2,7,9,11,"
; if single GRABIT, SORTIT and DISPLAY it; then exit.
I +PRCH2237 D G EXITD
. S PRCHIEN=""
. S PRCHTYPE=",1,4,6,8,10,",PRCHAND=",2,7,9,11,",PRCHSNGL=1
. S PRCHIEN=$O(^PRCV(414.06,"B",PRCH2237,PRCHIEN))
. S (PRCHCNT,PRCHEIEN)=0
. F S PRCHEIEN=$O(^PRCV(414.06,PRCHIEN,1,PRCHEIEN)) Q:+PRCHEIEN'>0 D GRABIT D
.. I PRCHDATA=0 K PRCHDATA Q
.. S PRCHEDT=$P(PRCHDATA(PRCHEIEN,0),"^"),PRCHEVNT=$P(PRCHDATA(PRCHEIEN,0),"^",2),PRCHESTN=$P(PRCH2237,"-")
.. D SORTIT
.. K PRCHDATA
..Q
. D DISPLAY
.Q
; loop on event date; GRABIT, CHECKS, SORTIT, new loop to add ACK Handshake data outside the date range, DISPLAY.
S PRCHLPDT=PRCHSTDT
F S PRCHLPDT=$O(^PRCV(414.06,"AED",PRCHLPDT)) Q:(+PRCHLPDT'>0)!($P(PRCHLPDT,".")>PRCHENDT) S PRCHAKLP=PRCHLPDT D
. S PRCHIEN=0
. F S PRCHIEN=$O(^PRCV(414.06,"AED",PRCHLPDT,PRCHIEN)) Q:+PRCHIEN'>0 D
.. S PRCHEIEN=0
.. F S PRCHEIEN=$O(^PRCV(414.06,"AED",PRCHLPDT,PRCHIEN,PRCHEIEN)) Q:+PRCHEIEN'>0 S PRCH2237=$P(^PRCV(414.06,PRCHIEN,0),"^") D GRABIT D
... I PRCHDATA=0 K PRCHDATA Q
... D CHECKS
... S PRCHEDT=$P(PRCHDATA(PRCHEIEN,0),"^"),PRCHEVNT=$P(PRCHDATA(PRCHEIEN,0),"^",2),PRCHESTN=$P(PRCH2237,"-")
... S:+PRCHEVNT=0 CHECKED=0
... D:CHECKED SORTIT
... K PRCH2237,PRCHDATA
...Q
..Q
.Q
; Grab any remaining ACK Handshake data, if any. By skipping CHECKS and SORTIT, only ACK handshake data is selected via GRABIT.
G:PRCHLPDT'>0 D1
S PRCHLPDT=PRCHAKLP
F S PRCHLPDT=$O(^PRCV(414.06,"AED",PRCHLPDT)) Q:(+PRCHLPDT'>0) D
. S PRCHIEN=0
. F S PRCHIEN=$O(^PRCV(414.06,"AED",PRCHLPDT,PRCHIEN)) Q:+PRCHIEN'>0 D
.. S PRCHEIEN=0
.. F S PRCHEIEN=$O(^PRCV(414.06,"AED",PRCHLPDT,PRCHIEN,PRCHEIEN)) Q:+PRCHEIEN'>0 S PRCH2237=$P(^PRCV(414.06,PRCHIEN,0),"^") D GRABIT D
... I PRCHDATA=0 K PRCHDATA Q
... K PRCH2237,PRCHDATA
...Q
..Q
.Q
D1 D DISPLAY
D EXITD
Q
CHECKS ; SCREENS - DATE RANGE AND TYPE HAVE ALREADY BEEN SCREENED
S CHECKED=0
S PRCHEDT=PRCHLPDT
S PRCH2237=$P(PRCHDATA(PRCHIEN,"IEN",0),"^")
; exit if FCP does not pass USER screen
S PRCHKSTN=$P(PRCH2237,"-"),PRCHKFCP=$P(PRCH2237,"-",4)
Q:$D(PRCHURCP(PRCHKFCP,PRCHKSTN))'=1
G:PRCHFUND="ALL" CHKECMS
; exit if FCP does not pass SELECTION screen
Q:PRCHKFCP'=PRCHFUND
CHKECMS ; if ecms contact = ALL continue, else exit if it does not pass the SELECTION screen
G:PRCHECMS="ALL" CHKSTN
Q:$P($G(PRCHDATA(PRCHEIEN,1)),"^",6)'=PRCHEML
CHKSTN ; screen station and substation
; if station = ALL and substation = ALL, continue
G:(PRCHSTN="ALL")&(PRCHSUB="ALL") CHKDONE
; if substation selected; i.e. - station = SUB and substation = substation ID, screen to continue
I PRCHSTN="SUB" Q:$P($G(PRCHDATA(PRCHEIEN,1)),"^",2)'=PRCHSUB
; if station selected and substation = ALL; screen to continue
I (+PRCHSTN)&(PRCHSUB="ALL") Q:+PRCHSTN'=PRCHKSTN
; if station selected and substation = NONE, screen to continue
I (+PRCHSTN)&(PRCHSUB="NONE") Q:+PRCHSTN'=PRCHKSTN G:($P($G(PRCHDATA(PRCHEIEN,1)),"^",2)="")!($P($G(PRCHDATA(PRCHEIEN,1)),"^",2)=PRCHKSTN) CHKDONE Q
CHKDONE ; still with me? set the flag! all checks successfull!
S CHECKED=1
Q
GRABIT ; pull data from global
S PRCHDATA=0
S PRCHDATA(PRCHIEN,"IEN",0)=^PRCV(414.06,PRCHIEN,0)
S PRCHDATA(PRCHEIEN,0)=^PRCV(414.06,PRCHIEN,1,PRCHEIEN,0)
;Build a list of handshake events. Needed to display "ack dates", etc.
S PRCHCTYP=","_$P(PRCHDATA(PRCHEIEN,0),"^",2)_","
I PRCHAND[PRCHCTYP S ^TMP("PRCHJRP6",$J,"PRCHAND",PRCH2237,$P(PRCHDATA(PRCHEIEN,0),"^",2),$P(^PRCV(414.06,PRCHIEN,1,PRCHEIEN,0),"^"),.5)=PRCHIEN_"^"_PRCHEIEN Q
Q:PRCHTYPE'[PRCHCTYP
S PRCHDATA(PRCHEIEN,1)=$G(^PRCV(414.06,PRCHIEN,1,PRCHEIEN,1))
S PRCHDATA(PRCHEIEN,2)=$G(^PRCV(414.06,PRCHIEN,1,PRCHEIEN,2))
S PRCHERR=0
F S PRCHERR=$O(^PRCV(414.06,PRCHIEN,1,PRCHEIEN,3,PRCHERR)) Q:+PRCHERR'>0 S PRCHDATA(PRCHEIEN,3,PRCHERR)=^PRCV(414.06,PRCHIEN,1,PRCHEIEN,3,PRCHERR,0)
S PRCHDATA=1
Q
SORTIT ; Drop data into TMP to sort it.
S ^TMP("PRCHJRP6",$J,PRCH2237,PRCHEDT,PRCHESTN,PRCHEVNT,.5)=PRCHDATA(PRCHIEN,"IEN",0)_"^"_PRCHIEN_"^"_PRCHEIEN
S ^TMP("PRCHJRP6",$J,PRCH2237,PRCHEDT,PRCHESTN,PRCHEVNT,0)=PRCHDATA(PRCHEIEN,0)
S ^TMP("PRCHJRP6",$J,PRCH2237,PRCHEDT,PRCHESTN,PRCHEVNT,1)=$G(PRCHDATA(PRCHEIEN,1))
S ^TMP("PRCHJRP6",$J,PRCH2237,PRCHEDT,PRCHESTN,PRCHEVNT,2)=$G(PRCHDATA(PRCHEIEN,2))
S ^TMP("PRCHJRP6",$J,PRCH2237,PRCHEDT,PRCHESTN,PRCHEVNT,3)=0
I $D(PRCHDATA(PRCHEIEN,3))=10 D
. S (PRCHERCT,PRCHERR)=0
. F S PRCHERR=$O(PRCHDATA(PRCHEIEN,3,PRCHERR)) Q:+PRCHERR'>0 S ^TMP("PRCHJRP6",$J,PRCH2237,PRCHEDT,PRCHESTN,PRCHEVNT,3,PRCHERR)=PRCHDATA(PRCHEIEN,3,PRCHERR),PRCHERCT=PRCHERCT+1
. S ^TMP("PRCHJRP6",$J,PRCH2237,PRCHEDT,PRCHESTN,PRCHEVNT,3)=PRCHERCT
.Q
Q
DISPLAY ; Selection and sort criteria have already been obtained.
U IO
D NOW^%DTC S Y=$J(%,7,4) D DD^%DT S PRCRUNDT=Y
S (PRCEXIT,PRCPAGE)=0,PRCHSHKE="2^^^2^^7^^9^^11"
D HEADER
S PRC2237="",PRCHNO=0
G:$D(^TMP("PRCHJRP6",$J))=0 DX
F S PRC2237=$O(^TMP("PRCHJRP6",$J,PRC2237)) Q:(PRC2237="PRCHAND")!(PRCEXIT)!(PRC2237="") D
. S PRCEDT=0,PRCHNO=1
. F S PRCEDT=$O(^TMP("PRCHJRP6",$J,PRC2237,PRCEDT)) Q:(+PRCEDT'>0)!(PRCEXIT) D
.. S PRCSTN=0
.. F PRCSTN=$O(^TMP("PRCHJRP6",$J,PRC2237,PRCEDT,PRCSTN)) Q:(+PRCSTN'>0)!(PRCEXIT) D
... S PRCEVENT=0
... F PRCEVENT=$O(^TMP("PRCHJRP6",$J,PRC2237,PRCEDT,PRCSTN,PRCEVENT)) Q:(+PRCEVENT'>0)!(PRCEXIT) D
... S NODEHALF=^TMP("PRCHJRP6",$J,PRC2237,PRCEDT,PRCSTN,PRCEVENT,.5)
... S NODE0=^TMP("PRCHJRP6",$J,PRC2237,PRCEDT,PRCSTN,PRCEVENT,0)
... S NODE1=^TMP("PRCHJRP6",$J,PRC2237,PRCEDT,PRCSTN,PRCEVENT,1)
... S NODE2=^TMP("PRCHJRP6",$J,PRC2237,PRCEDT,PRCSTN,PRCEVENT,2)
... S PRCACKER=^TMP("PRCHJRP6",$J,PRC2237,PRCEDT,PRCSTN,PRCEVENT,3)
... ; PRC2237 - EVENT TEXT - EVENT DATE
... S PRCEVTX=$P(^PRCV(414.07,PRCEVENT,0),"^")
... S Y=PRCEDT D DD^%DT S PRCEDTX=Y
... W !,PRC2237,?21,PRCEVTX,?58,PRCEDTX
... ; SUBSTATION (PRIMARY) - HANDSHAKE EVENT DATE - (set handshake event iens for future use)
... S PRCHSDT=PRCEDT,PRCHEVT=$P(PRCHSHKE,"^",PRCEVENT)
... F S PRCHSDT=$O(^TMP("PRCHJRP6",$J,"PRCHAND",PRC2237,PRCHEVT,PRCHSDT)) S:PRCHSDT'="" PRCHSI=$P(^TMP("PRCHJRP6",$J,"PRCHAND",PRC2237,PRCHEVT,PRCHSDT,.5),"^"),PRCHSEI=$P(^TMP("PRCHJRP6",$J,"PRCHAND",PRC2237,PRCHEVT,PRCHSDT,.5),"^",2) Q
... S:PRCHSDT'="" Y=PRCHSDT D DD^%DT S PRCHSDTX=Y
... S:PRCHSDT="" PRCHSDTX="(Pending)"
... W !
... W:$P(NODE1,"^",2)'="" "SUBSTATION: "_$P(NODE1,"^",2)
... W ?44,"ACKNOWLEDGED: "_PRCHSDTX
... ; eCMS CONTACT - eCMS PHONE
... W:(PRCEVENT'=1)&(PRCEVENT'=4) !,"eCMS CONTACT: "_$P(NODE1,"^",6),?44,"PHONE: "_$P(NODE1,"^",5)
... ; RETURN/CANCEL DATE and COMMENT or REASON TEXT
... I $P(NODE1,"^",7)'="" S Y=$P(NODE1,"^",7) D DD^%DT W !,"RETURN/CANCEL DATE: "_Y
... W:(NODE2'="")&(NODE2'="^")&(PRCEVENT'=1) !,"REASON/COMMENT: "_$S($P(NODE2,"^",2)'="":$P(NODE2,"^",2),1:$P(NODE2,"^"))
... ; ERROR TEXT IF ANY, BOTH MAIN AND HANDSHAKE
... I PRCACKER>0 D
.... I 'PRCHERTX W !,"This "_PRCEVTX_" has ERROR TEXT." Q
.... W !,"ERROR TEXT FOR "_PRCEVTX_":"
.... S PRCI=0
.... F S PRCI=$O(^TMP("PRCHJRP6",$J,PRC2237,PRCEDT,PRCSTN,PRCEVENT,3,PRCI)) Q:(+PRCI'>0)!(PRCEXIT) D:(IOSL-$Y)<4 HEADER Q:PRCEXIT W !," ",^TMP("PRCHJRP6",$J,PRC2237,PRCEDT,PRCSTN,PRCEVENT,3,PRCI)
....Q
... I PRCHSDT'="" D
.... I $D(^PRCV(414.06,PRCHSI,1,PRCHSEI,3))>0 D
..... I 'PRCHERTX W !,"This "_PRCEVTX_" has ACKNOWLEDGMENT ERROR TEXT." Q
..... W !,"ACKNOWLEDGMENT ERROR TEXT FOR "_PRCEVTX_":"
..... S PRCI=0
..... F S PRCI=$O(^PRCV(414.06,PRCHSI,1,PRCHSEI,3,PRCI)) Q:(+PRCI'>0)!(PRCEXIT) D:(IOSL-$Y)<4 HEADER Q:PRCEXIT W !," ",^PRCV(414.06,PRCHSI,1,PRCHSEI,3,PRCI,0)
.....Q
....Q
... W !
... ; PAGE BREAK CHECK
... D:((IOSL-$Y)<4)&(PRCEXIT'=1) HEADER
... Q:PRCEXIT
...Q
..Q
.Q
DX W !,?25,$S(PRCEXIT:"USER ABORTED REPORT",PRCHNO=1:"END OF REPORT",PRCHNO=0:"NO DATA TO REPORT!",1:""),!
G:PRCEXIT EXITD
I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR
S:$D(ZTQUEUED) ZTREQ="@"
D EXITZT^PRCHJRP5
D EXITD
Q
I PRCPAGE>0 W ! I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR S:+$G(DUOUT)!$G(DTOUT) PRCEXIT=1
Q:PRCEXIT
S PRCPAGE=PRCPAGE+1
W:PRCPAGE>1 @IOF
W !,PRCRUNDT,?25,"eCMS/IFCAP TRANSACTION LOG REPORT",?74,"p. "_PRCPAGE
I PRCHSNGL W !!,"eCMS 2237: ",PRCH2237 G TABLE
W !!,"eCMS 2237: ",PRCH37,?17,"eCMS Contact: ",PRCHEML,?65,"Station: ",$S(PRCHSTN="SUB":+PRCHSUB,1:PRCHSTN)
W !,"Report Date Range: "_PRCHSTAR_" - "_PRCHEND,?59,"Control Point: ",PRCHFUND
W !,"Events: ",PRCHTYTX
TABLE W !!,"IFCAP Reference",?21,"Message Event",?58,"Event Date"
W ! S L="",$P(L,"_",IOM)="_" W L S L=""
Q
EXITD ; Exit display portion
K ^TMP("PRCHJRP6",$J)
K %,DTOUT,DUOUT,I,L,POP,PRCETMP0,PRCETMP1,PRCETMP3,PRCH411,PRCHAKLP,PRCHI,PRCHINIC,PRCHINSN,PRCHJ,PRCHNO,PRCHSLTY,PRCHTT,XQOPT,ZTQUEUED,ZTREQ
K PRCH2237,PRCHDATA,PRCHECMS,PRCHEML,PRCHEND,PRCHENDT,PRCHERTX,PRCHFUND,PRCHSNGL,PRCHSTAR,PRCHSTDT,PRCHSTN,PRCHSUB,PRCHTYPE,PRCHTYTX,PRCHURCP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHJRP6 10089 printed Sep 23, 2025@19:44:17 Page 2
PRCHJRP6 ;OI&T/DDA - Transaction Report from 414.06 [CONT.] ;5/21/13 13:48
V ;;5.1;IFCAP;**174**;Oct 20,2000;Build 23
+1 ;Per VHA Directive 2004-38, this routine should not be modified.
+2 ;
+3 QUIT
GATHER ;
+1 KILL ^TMP("PRCHJRP6",$JOB)
+2 NEW CHECKED,NODE0,NODE1,NODE2,NODEHALF,DIR,Y
+3 NEW PRC2237,PRCACKER,PRCEDT,PRCEDTX,PRCEVENT,PRCEVTX,PRCEXIT,PRCI,PRCPAGE,PRCRUNDT,PRCSTN
+4 NEW PRCH37,PRCHAND,PRCHCNT,PRCHCTYP,PRCHEDT,PRCHEIEN,PRCHERCT,PRCHERR,PRCHESTN,PRCHEVNT,PRCHEVT,PRCHIEN,PRCHKFCP,PRCHKSTN,PRCHLPDT,PRCHSDT,PRCHSDTX,PRCHSHKE,PRCHSEI,PRCHSI,PRCHSNGL
+5 SET PRCHSNGL=0
SET PRCH37=PRCH2237
+6 ; Build the handshake events for those primary events selected.
+7 IF PRCH2237="ALL"
Begin DoDot:1
+8 IF $GET(PRCHTYPE)'="ALL"
Begin DoDot:2
+9 ; Include RESENT (4) to be equal to SEND (1) event
+10 SET PRCHAND=","
SET PRCHTYPE=","_PRCHTYPE
+11 if PRCHTYPE[",1,"
SET PRCHAND=PRCHAND_"2,"
SET PRCHTYPE=",1,4,"_$PIECE(PRCHTYPE,",1,",2)
+12 if PRCHTYPE[",6,"
SET PRCHAND=PRCHAND_"7,"
+13 if PRCHTYPE[",8,"
SET PRCHAND=PRCHAND_"9,"
+14 if PRCHTYPE[",10,"
SET PRCHAND=PRCHAND_"11,"
+15 QUIT
End DoDot:2
+16 IF PRCHTYPE="ALL"
SET PRCHTYPE=",1,4,6,8,10,"
SET PRCHAND=",2,7,9,11,"
End DoDot:1
+17 ; if single GRABIT, SORTIT and DISPLAY it; then exit.
+18 IF +PRCH2237
Begin DoDot:1
+19 SET PRCHIEN=""
+20 SET PRCHTYPE=",1,4,6,8,10,"
SET PRCHAND=",2,7,9,11,"
SET PRCHSNGL=1
+21 SET PRCHIEN=$ORDER(^PRCV(414.06,"B",PRCH2237,PRCHIEN))
+22 SET (PRCHCNT,PRCHEIEN)=0
+23 FOR
SET PRCHEIEN=$ORDER(^PRCV(414.06,PRCHIEN,1,PRCHEIEN))
if +PRCHEIEN'>0
QUIT
DO GRABIT
Begin DoDot:2
+24 IF PRCHDATA=0
KILL PRCHDATA
QUIT
+25 SET PRCHEDT=$PIECE(PRCHDATA(PRCHEIEN,0),"^")
SET PRCHEVNT=$PIECE(PRCHDATA(PRCHEIEN,0),"^",2)
SET PRCHESTN=$PIECE(PRCH2237,"-")
+26 DO SORTIT
+27 KILL PRCHDATA
+28 QUIT
End DoDot:2
+29 DO DISPLAY
+30 QUIT
End DoDot:1
GOTO EXITD
+31 ; loop on event date; GRABIT, CHECKS, SORTIT, new loop to add ACK Handshake data outside the date range, DISPLAY.
+32 SET PRCHLPDT=PRCHSTDT
+33 FOR
SET PRCHLPDT=$ORDER(^PRCV(414.06,"AED",PRCHLPDT))
if (+PRCHLPDT'>0)!($PIECE(PRCHLPDT,".")>PRCHENDT)
QUIT
SET PRCHAKLP=PRCHLPDT
Begin DoDot:1
+34 SET PRCHIEN=0
+35 FOR
SET PRCHIEN=$ORDER(^PRCV(414.06,"AED",PRCHLPDT,PRCHIEN))
if +PRCHIEN'>0
QUIT
Begin DoDot:2
+36 SET PRCHEIEN=0
+37 FOR
SET PRCHEIEN=$ORDER(^PRCV(414.06,"AED",PRCHLPDT,PRCHIEN,PRCHEIEN))
if +PRCHEIEN'>0
QUIT
SET PRCH2237=$PIECE(^PRCV(414.06,PRCHIEN,0),"^")
DO GRABIT
Begin DoDot:3
+38 IF PRCHDATA=0
KILL PRCHDATA
QUIT
+39 DO CHECKS
+40 SET PRCHEDT=$PIECE(PRCHDATA(PRCHEIEN,0),"^")
SET PRCHEVNT=$PIECE(PRCHDATA(PRCHEIEN,0),"^",2)
SET PRCHESTN=$PIECE(PRCH2237,"-")
+41 if +PRCHEVNT=0
SET CHECKED=0
+42 if CHECKED
DO SORTIT
+43 KILL PRCH2237,PRCHDATA
+44 QUIT
End DoDot:3
+45 QUIT
End DoDot:2
+46 QUIT
End DoDot:1
+47 ; Grab any remaining ACK Handshake data, if any. By skipping CHECKS and SORTIT, only ACK handshake data is selected via GRABIT.
+48 if PRCHLPDT'>0
GOTO D1
+49 SET PRCHLPDT=PRCHAKLP
+50 FOR
SET PRCHLPDT=$ORDER(^PRCV(414.06,"AED",PRCHLPDT))
if (+PRCHLPDT'>0)
QUIT
Begin DoDot:1
+51 SET PRCHIEN=0
+52 FOR
SET PRCHIEN=$ORDER(^PRCV(414.06,"AED",PRCHLPDT,PRCHIEN))
if +PRCHIEN'>0
QUIT
Begin DoDot:2
+53 SET PRCHEIEN=0
+54 FOR
SET PRCHEIEN=$ORDER(^PRCV(414.06,"AED",PRCHLPDT,PRCHIEN,PRCHEIEN))
if +PRCHEIEN'>0
QUIT
SET PRCH2237=$PIECE(^PRCV(414.06,PRCHIEN,0),"^")
DO GRABIT
Begin DoDot:3
+55 IF PRCHDATA=0
KILL PRCHDATA
QUIT
+56 KILL PRCH2237,PRCHDATA
+57 QUIT
End DoDot:3
+58 QUIT
End DoDot:2
+59 QUIT
End DoDot:1
D1 DO DISPLAY
+1 DO EXITD
+2 QUIT
CHECKS ; SCREENS - DATE RANGE AND TYPE HAVE ALREADY BEEN SCREENED
+1 SET CHECKED=0
+2 SET PRCHEDT=PRCHLPDT
+3 SET PRCH2237=$PIECE(PRCHDATA(PRCHIEN,"IEN",0),"^")
+4 ; exit if FCP does not pass USER screen
+5 SET PRCHKSTN=$PIECE(PRCH2237,"-")
SET PRCHKFCP=$PIECE(PRCH2237,"-",4)
+6 if $DATA(PRCHURCP(PRCHKFCP,PRCHKSTN))'=1
QUIT
+7 if PRCHFUND="ALL"
GOTO CHKECMS
+8 ; exit if FCP does not pass SELECTION screen
+9 if PRCHKFCP'=PRCHFUND
QUIT
CHKECMS ; if ecms contact = ALL continue, else exit if it does not pass the SELECTION screen
+1 if PRCHECMS="ALL"
GOTO CHKSTN
+2 if $PIECE($GET(PRCHDATA(PRCHEIEN,1)),"^",6)'=PRCHEML
QUIT
CHKSTN ; screen station and substation
+1 ; if station = ALL and substation = ALL, continue
+2 if (PRCHSTN="ALL")&(PRCHSUB="ALL")
GOTO CHKDONE
+3 ; if substation selected; i.e. - station = SUB and substation = substation ID, screen to continue
+4 IF PRCHSTN="SUB"
if $PIECE($GET(PRCHDATA(PRCHEIEN,1)),"^",2)'=PRCHSUB
QUIT
+5 ; if station selected and substation = ALL; screen to continue
+6 IF (+PRCHSTN)&(PRCHSUB="ALL")
if +PRCHSTN'=PRCHKSTN
QUIT
+7 ; if station selected and substation = NONE, screen to continue
+8 IF (+PRCHSTN)&(PRCHSUB="NONE")
if +PRCHSTN'=PRCHKSTN
QUIT
if ($PIECE($GET(PRCHDATA(PRCHEIEN,1)),"^",2)="")!($PIECE($GET(PRCHDATA(PRCHEIEN,1)),"^",2)=PRCHKSTN)
GOTO CHKDONE
QUIT
CHKDONE ; still with me? set the flag! all checks successfull!
+1 SET CHECKED=1
+2 QUIT
GRABIT ; pull data from global
+1 SET PRCHDATA=0
+2 SET PRCHDATA(PRCHIEN,"IEN",0)=^PRCV(414.06,PRCHIEN,0)
+3 SET PRCHDATA(PRCHEIEN,0)=^PRCV(414.06,PRCHIEN,1,PRCHEIEN,0)
+4 ;Build a list of handshake events. Needed to display "ack dates", etc.
+5 SET PRCHCTYP=","_$PIECE(PRCHDATA(PRCHEIEN,0),"^",2)_","
+6 IF PRCHAND[PRCHCTYP
SET ^TMP("PRCHJRP6",$JOB,"PRCHAND",PRCH2237,$PIECE(PRCHDATA(PRCHEIEN,0),"^",2),$PIECE(^PRCV(414.06,PRCHIEN,1,PRCHEIEN,0),"^"),.5)=PRCHIEN_"^"_PRCHEIEN
QUIT
+7 if PRCHTYPE'[PRCHCTYP
QUIT
+8 SET PRCHDATA(PRCHEIEN,1)=$GET(^PRCV(414.06,PRCHIEN,1,PRCHEIEN,1))
+9 SET PRCHDATA(PRCHEIEN,2)=$GET(^PRCV(414.06,PRCHIEN,1,PRCHEIEN,2))
+10 SET PRCHERR=0
+11 FOR
SET PRCHERR=$ORDER(^PRCV(414.06,PRCHIEN,1,PRCHEIEN,3,PRCHERR))
if +PRCHERR'>0
QUIT
SET PRCHDATA(PRCHEIEN,3,PRCHERR)=^PRCV(414.06,PRCHIEN,1,PRCHEIEN,3,PRCHERR,0)
+12 SET PRCHDATA=1
+13 QUIT
SORTIT ; Drop data into TMP to sort it.
+1 SET ^TMP("PRCHJRP6",$JOB,PRCH2237,PRCHEDT,PRCHESTN,PRCHEVNT,.5)=PRCHDATA(PRCHIEN,"IEN",0)_"^"_PRCHIEN_"^"_PRCHEIEN
+2 SET ^TMP("PRCHJRP6",$JOB,PRCH2237,PRCHEDT,PRCHESTN,PRCHEVNT,0)=PRCHDATA(PRCHEIEN,0)
+3 SET ^TMP("PRCHJRP6",$JOB,PRCH2237,PRCHEDT,PRCHESTN,PRCHEVNT,1)=$GET(PRCHDATA(PRCHEIEN,1))
+4 SET ^TMP("PRCHJRP6",$JOB,PRCH2237,PRCHEDT,PRCHESTN,PRCHEVNT,2)=$GET(PRCHDATA(PRCHEIEN,2))
+5 SET ^TMP("PRCHJRP6",$JOB,PRCH2237,PRCHEDT,PRCHESTN,PRCHEVNT,3)=0
+6 IF $DATA(PRCHDATA(PRCHEIEN,3))=10
Begin DoDot:1
+7 SET (PRCHERCT,PRCHERR)=0
+8 FOR
SET PRCHERR=$ORDER(PRCHDATA(PRCHEIEN,3,PRCHERR))
if +PRCHERR'>0
QUIT
SET ^TMP("PRCHJRP6",$JOB,PRCH2237,PRCHEDT,PRCHESTN,PRCHEVNT,3,PRCHERR)=PRCHDATA(PRCHEIEN,3,PRCHERR)
SET PRCHERCT=PRCHERCT+1
+9 SET ^TMP("PRCHJRP6",$JOB,PRCH2237,PRCHEDT,PRCHESTN,PRCHEVNT,3)=PRCHERCT
+10 QUIT
End DoDot:1
+11 QUIT
DISPLAY ; Selection and sort criteria have already been obtained.
+1 USE IO
+2 DO NOW^%DTC
SET Y=$JUSTIFY(%,7,4)
DO DD^%DT
SET PRCRUNDT=Y
+3 SET (PRCEXIT,PRCPAGE)=0
SET PRCHSHKE="2^^^2^^7^^9^^11"
+4 DO HEADER
+5 SET PRC2237=""
SET PRCHNO=0
+6 if $DATA(^TMP("PRCHJRP6",$JOB))=0
GOTO DX
+7 FOR
SET PRC2237=$ORDER(^TMP("PRCHJRP6",$JOB,PRC2237))
if (PRC2237="PRCHAND")!(PRCEXIT)!(PRC2237="")
QUIT
Begin DoDot:1
+8 SET PRCEDT=0
SET PRCHNO=1
+9 FOR
SET PRCEDT=$ORDER(^TMP("PRCHJRP6",$JOB,PRC2237,PRCEDT))
if (+PRCEDT'>0)!(PRCEXIT)
QUIT
Begin DoDot:2
+10 SET PRCSTN=0
+11 FOR PRCSTN=$ORDER(^TMP("PRCHJRP6",$JOB,PRC2237,PRCEDT,PRCSTN))
if (+PRCSTN'>0)!(PRCEXIT)
QUIT
Begin DoDot:3
+12 SET PRCEVENT=0
+13 FOR PRCEVENT=$ORDER(^TMP("PRCHJRP6",$JOB,PRC2237,PRCEDT,PRCSTN,PRCEVENT))
if (+PRCEVENT'>0)!(PRCEXIT)
QUIT
Begin DoDot:4
End DoDot:4
+14 SET NODEHALF=^TMP("PRCHJRP6",$JOB,PRC2237,PRCEDT,PRCSTN,PRCEVENT,.5)
+15 SET NODE0=^TMP("PRCHJRP6",$JOB,PRC2237,PRCEDT,PRCSTN,PRCEVENT,0)
+16 SET NODE1=^TMP("PRCHJRP6",$JOB,PRC2237,PRCEDT,PRCSTN,PRCEVENT,1)
+17 SET NODE2=^TMP("PRCHJRP6",$JOB,PRC2237,PRCEDT,PRCSTN,PRCEVENT,2)
+18 SET PRCACKER=^TMP("PRCHJRP6",$JOB,PRC2237,PRCEDT,PRCSTN,PRCEVENT,3)
+19 ; PRC2237 - EVENT TEXT - EVENT DATE
+20 SET PRCEVTX=$PIECE(^PRCV(414.07,PRCEVENT,0),"^")
+21 SET Y=PRCEDT
DO DD^%DT
SET PRCEDTX=Y
+22 WRITE !,PRC2237,?21,PRCEVTX,?58,PRCEDTX
+23 ; SUBSTATION (PRIMARY) - HANDSHAKE EVENT DATE - (set handshake event iens for future use)
+24 SET PRCHSDT=PRCEDT
SET PRCHEVT=$PIECE(PRCHSHKE,"^",PRCEVENT)
+25 FOR
SET PRCHSDT=$ORDER(^TMP("PRCHJRP6",$JOB,"PRCHAND",PRC2237,PRCHEVT,PRCHSDT))
if PRCHSDT'=""
SET PRCHSI=$PIECE(^TMP("PRCHJRP6",$JOB,"PRCHAND",PRC2237,PRCHEVT,PRCHSDT,.5),"^")
SET PRCHSEI=$PIECE(^TMP("PRCHJRP6",$JOB,"PRCHAND",PRC2237,PRCHEVT,PRCHSDT,.5),"^",2)
QUIT
+26 if PRCHSDT'=""
SET Y=PRCHSDT
DO DD^%DT
SET PRCHSDTX=Y
+27 if PRCHSDT=""
SET PRCHSDTX="(Pending)"
+28 WRITE !
+29 if $PIECE(NODE1,"^",2)'=""
WRITE "SUBSTATION: "_$PIECE(NODE1,"^",2)
+30 WRITE ?44,"ACKNOWLEDGED: "_PRCHSDTX
+31 ; eCMS CONTACT - eCMS PHONE
+32 if (PRCEVENT'=1)&(PRCEVENT'=4)
WRITE !,"eCMS CONTACT: "_$PIECE(NODE1,"^",6),?44,"PHONE: "_$PIECE(NODE1,"^",5)
+33 ; RETURN/CANCEL DATE and COMMENT or REASON TEXT
+34 IF $PIECE(NODE1,"^",7)'=""
SET Y=$PIECE(NODE1,"^",7)
DO DD^%DT
WRITE !,"RETURN/CANCEL DATE: "_Y
+35 if (NODE2'="")&(NODE2'="^")&(PRCEVENT'=1)
WRITE !,"REASON/COMMENT: "_$SELECT($PIECE(NODE2,"^",2)'="":$PIECE(NODE2,"^",2),1:$PIECE(NODE2,"^"))
+36 ; ERROR TEXT IF ANY, BOTH MAIN AND HANDSHAKE
+37 IF PRCACKER>0
Begin DoDot:4
+38 IF 'PRCHERTX
WRITE !,"This "_PRCEVTX_" has ERROR TEXT."
QUIT
+39 WRITE !,"ERROR TEXT FOR "_PRCEVTX_":"
+40 SET PRCI=0
+41 FOR
SET PRCI=$ORDER(^TMP("PRCHJRP6",$JOB,PRC2237,PRCEDT,PRCSTN,PRCEVENT,3,PRCI))
if (+PRCI'>0)!(PRCEXIT)
QUIT
if (IOSL-$Y)<4
DO HEADER
if PRCEXIT
QUIT
WRITE !," ",^TMP("PRCHJRP6",$JOB,PRC2237,PRCEDT,PRCSTN,PRCEVENT,3,PRCI)
+42 QUIT
End DoDot:4
+43 IF PRCHSDT'=""
Begin DoDot:4
+44 IF $DATA(^PRCV(414.06,PRCHSI,1,PRCHSEI,3))>0
Begin DoDot:5
+45 IF 'PRCHERTX
WRITE !,"This "_PRCEVTX_" has ACKNOWLEDGMENT ERROR TEXT."
QUIT
+46 WRITE !,"ACKNOWLEDGMENT ERROR TEXT FOR "_PRCEVTX_":"
+47 SET PRCI=0
+48 FOR
SET PRCI=$ORDER(^PRCV(414.06,PRCHSI,1,PRCHSEI,3,PRCI))
if (+PRCI'>0)!(PRCEXIT)
QUIT
if (IOSL-$Y)<4
DO HEADER
if PRCEXIT
QUIT
WRITE !," ",^PRCV(414.06,PRCHSI,1,PRCHSEI,3,PRCI,0)
+49 QUIT
End DoDot:5
+50 QUIT
End DoDot:4
+51 WRITE !
+52 ; PAGE BREAK CHECK
+53 if ((IOSL-$Y)<4)&(PRCEXIT'=1)
DO HEADER
+54 if PRCEXIT
QUIT
+55 QUIT
End DoDot:3
+56 QUIT
End DoDot:2
+57 QUIT
End DoDot:1
DX WRITE !,?25,$SELECT(PRCEXIT:"USER ABORTED REPORT",PRCHNO=1:"END OF REPORT",PRCHNO=0:"NO DATA TO REPORT!",1:""),!
+1 if PRCEXIT
GOTO EXITD
+2 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
+3 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 DO EXITZT^PRCHJRP5
+5 DO EXITD
+6 QUIT
+1 IF PRCPAGE>0
WRITE !
IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
if +$GET(DUOUT)!$GET(DTOUT)
SET PRCEXIT=1
+2 if PRCEXIT
QUIT
+3 SET PRCPAGE=PRCPAGE+1
+4 if PRCPAGE>1
WRITE @IOF
+5 WRITE !,PRCRUNDT,?25,"eCMS/IFCAP TRANSACTION LOG REPORT",?74,"p. "_PRCPAGE
+6 IF PRCHSNGL
WRITE !!,"eCMS 2237: ",PRCH2237
GOTO TABLE
+7 WRITE !!,"eCMS 2237: ",PRCH37,?17,"eCMS Contact: ",PRCHEML,?65,"Station: ",$SELECT(PRCHSTN="SUB":+PRCHSUB,1:PRCHSTN)
+8 WRITE !,"Report Date Range: "_PRCHSTAR_" - "_PRCHEND,?59,"Control Point: ",PRCHFUND
+9 WRITE !,"Events: ",PRCHTYTX
TABLE WRITE !!,"IFCAP Reference",?21,"Message Event",?58,"Event Date"
+1 WRITE !
SET L=""
SET $PIECE(L,"_",IOM)="_"
WRITE L
SET L=""
+2 QUIT
EXITD ; Exit display portion
+1 KILL ^TMP("PRCHJRP6",$JOB)
+2 KILL %,DTOUT,DUOUT,I,L,POP,PRCETMP0,PRCETMP1,PRCETMP3,PRCH411,PRCHAKLP,PRCHI,PRCHINIC,PRCHINSN,PRCHJ,PRCHNO,PRCHSLTY,PRCHTT,XQOPT,ZTQUEUED,ZTREQ
+3 KILL PRCH2237,PRCHDATA,PRCHECMS,PRCHEML,PRCHEND,PRCHENDT,PRCHERTX,PRCHFUND,PRCHSNGL,PRCHSTAR,PRCHSTDT,PRCHSTN,PRCHSUB,PRCHTYPE,PRCHTYTX,PRCHURCP
+4 QUIT
