PRCHJRP6.m

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

HEADER ; Page header, etc.

 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 ---PRCHJRP6   10089     printed  Apr 23, 2025@18:22:42                                                                                                                                                                                                   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 

HEADER    ; Page header, etc.

 +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