SCMCHLR9.m

SCMCHLR9 ;ALB/KCL - PCMM HL7 Reject Transmission Report Con't; 22-FEB-2000

 ;;5.3;Scheduling;**210,284,297**;AUG 13,1993

 ;

PRINT ; Description: Used to print report.

 ;

 ;Init variables

 N CRT,QUIT,PAGE,SUBSCRPT,SCARRAY

 K SCARRAY

 S SCARRAY="SCERRSRT"

 K ^TMP(SCARRAY,$J)

 S (QUIT,PAGE)=0

 S CRT=$S($E(IOST,1,2)="C-":1,1:0)

 ;

 ;Get PCMM HL7 Transmission Log errors

 D GET^SCMCHLR2(SCARRAY,$G(SCRP("BEGIN")),$G(SCRP("END")),$G(SCRP("EPS")),$G(SCRP("SORT")))

 ;

 U IO

 I CRT,PAGE=0 W @IOF

 S PAGE=1

 D HEADER

 D PRINTERR($G(SCRP("SORT")),$G(SCRP("EPS")))

 I CRT,'QUIT D PAUSE

 I $D(ZTQUEUED) S ZTREQ="@"

 D ^%ZISC

 ;

 K ^TMP(SCARRAY,$J)

 Q

 ;

LINE(LINE) ;

 ; Description: Prints a line. First prints header if at end of page.

 ;

 I CRT,($Y>(IOSL-4)) D

 .D PAUSE

 .Q:QUIT

 .W @IOF

 .D HEADER

 .W LINE

 ;

 E  I ('CRT),($Y>(IOSL-2)) D

 .W @IOF

 .D HEADER

 .W LINE

 ;

 E  W !,LINE

 Q

 ;

 ;

HEADER ; Description: Prints the report header.

 ;

 N LINE,X

 I $Y>1 W @IOF

 W !,"PCMM Transmission Error Report"

 W ?33,"Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT,"1P")

 W ?70,"Page ",PAGE

 S PAGE=PAGE+1

 W !

 S X=$G(SCRP("SORT"))

 W !,"Sort By: "_$S(X="N":"Patient Name",X="D":"Date Error Received",X="P":"Provider",1:"Unknown")

 I SCRP("BEGIN") D

 .W ?40,"Date Range: "_$$FMTE^XLFDT(SCRP("BEGIN"))_" to "_$$FMTE^XLFDT($G(SCRP("END")))

 E  D

 .W ?40,"Date Range: "_$$DRMSG^SCMCHLR1

 S X=$G(SCRP("EPS"))

 W !,"Error Processing Status: "_$S(X=1:"New",X=2:"Checked",X=3:"New/Checked",1:"Unknown")

 W ?40,$$MRKMSG^SCMCHLR1

 W !

 ;

 W !?2,"Patient Name",?23,"PATID",?31,"Date Rec",?42,"Provider",?63,"Type",?70,"EP Status"

 S $P(LINE,"-",80)="-"

 W !,LINE,!

 Q

 ;

 ;

PAUSE ; Description: Screen pause.  Sets QUIT=1 if user decides to quit.

 ;

 N DIR,X,Y

 F  Q:$Y>(IOSL-3)  W !

 S DIR(0)="E"

 D ^DIR

 I ('(+Y))!$D(DIRUT) S QUIT=1

 Q

 ;

 ;

PRINTERR(SCSORTBY,SCEPS) ; Description: Print list of errors.

 ;

 ;  Input:

 ;   SCSORTBY - Sort by criteria

 ;               N -> Patient Name

 ;               D -> Date/Time Ack Received

 ;               P -> Provider

 ;      SCEPS -  Error processing status

 ;

 ; Output: None

 ;

 N DFN,SCSUB,SCLINE,SCTXT,SCTLIEN,SCERIEN,SCTLOG,SCPROV,SCTYPE

 ;

 ;Loop thru sort array by pat name, OR date ack rec'd, OR provider

 S SCSUB=$S(SCSORTBY="N":"",SCSORTBY="P":"",1:0)

 F  S SCSUB=$O(^TMP("SCERRSRT",$J,SCSORTBY,SCSUB)) Q:SCSUB=""  D  Q:QUIT

 .;loop through PCMM HL7 Transmission Log ien(s)

 .S SCTLIEN=0

 .F  S SCTLIEN=$O(^TMP("SCERRSRT",$J,SCSORTBY,SCSUB,SCTLIEN)) Q:'SCTLIEN  D  Q:QUIT

 ..;loop through Error Code subfile ien(s)

 ..S SCERIEN=0

 ..F  S SCERIEN=$O(^TMP("SCERRSRT",$J,SCSORTBY,SCSUB,SCTLIEN,SCERIEN)) Q:'SCERIEN  D  Q:QUIT

 ...;

 ...;get data for PCMM HL7 Trans Log entry

 ...I $$GETLOG^SCMCHLA(SCTLIEN,SCERIEN,.SCTLOG) D

 ....;

 ....;set retransmit flag in line

 ....S SCLINE=$S($G(SCTLOG("STATUS"))="M":"*",1:" ")

 ....;

 ....;set patient name in line

 ....S SCTXT=$$LOWER^VALM1($S($G(SCTLOG("WORK")):"WORKLOAD",$G(SCTLOG("DFN")):$P($G(^DPT(SCTLOG("DFN"),0)),"^",1),1:"UNKNOWN"))

 ....S SCLINE=SCLINE_" "_$$LJ(SCTXT,18)

 ....;

 ....;set patient id in line

 ....S DFN=+SCTLOG("DFN") D PID^VADPT

 ....;D SET(SCARY,SCLINE,VA("BID"),SCCOL("PATID"),SCWID("PATID"),SCNUM,,,,.SCCNT)

 ....S SCLINE=SCLINE_"   "_$$LJ(VA("BID"),5)

 ....;

 ....;set date ack received in line

 ....S SCTXT=$$LOWER^VALM1($S($G(SCTLOG("ACK DT/TM")):$E($$FDATE^VALM1(SCTLOG("ACK DT/TM")),1,8),1:"UNKNOWN"))

 ....S SCLINE=SCLINE_"   "_$$LJ(SCTXT,8)

 ....;

 ....;set provider in display in line

 ....K SCHL

 ....S SCPROV=""

 ....;only get provider if ZPC segment error

 ....I $G(SCTLOG("WORK")) S SCPROV=$P($G(^SCPT(404.471,SCTLIEN,0)),U,8)

 ....I $G(SCTLOG("ERR","SEG"))="ZPC" D

 .....I $$GETHL7ID^SCMCHLA2($G(SCTLOG("ERR","ZPCID")),.SCHL)

 .....S SCPTR=$P($G(SCHL("HL7ID")),"-",2)

 .....I '$G(SCTLOG("WORK")) S SCPROV=$P($G(^SCTM(404.52,+$G(SCPTR),0)),"^",3)

 ....S SCTXT=$$LOWER^VALM1($S($G(SCPROV)'="":$$EXTERNAL^DILFD(404.52,.03,,SCPROV),1:"N/A"))

 ....S SCLINE=SCLINE_"   "_$$LJ(SCTXT,18)

 ....;

 ....;set provider type in line

 ....S SCTYPE=$P($G(SCHL("HL7ID")),"-",4)

 ....S SCTXT=$S(SCTYPE'="":SCTYPE,1:"N/A")

 ....S SCLINE=SCLINE_"   "_$$LJ(SCTXT,4)

 ....;

 ....;set error processing status in line

 ....S SCTXT=$$LOWER^VALM1($S($G(SCTLOG("ERR","EPS")):$$EXTERNAL^DILFD(404.47142,.06,,SCTLOG("ERR","EPS")),1:"UNKNOWN"))

 ....S SCLINE=SCLINE_"   "_$$LJ(SCTXT,7)

 ....;

 ....D LINE(SCLINE) Q:QUIT

 ....;

 ....;set error code/desc in line

 ....I $$GETEC^SCMCHLA2($G(SCTLOG("ERR","CODE")),.SCERR)

 ....S SCTXT="     Error: "_$S($G(SCERR("CODE"))'="":SCERR("CODE")_"-"_$G(SCERR("SHORT")),1:$$LOWER^VALM1("UNKNOWN"))

 ....S SCLINE=$$LJ(SCTXT,80)

 ....D LINE(SCLINE) Q:QUIT

 ;

 Q

 ;

 ;

LJ(STRING,LENGTH) ;

 ;

 Q $$LJ^XLFSTR($E(STRING,1,LENGTH),LENGTH)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SCMCHLR9   4913     printed  Apr 23, 2025@18:55:09                                                                                                                                                                                                    Page 2

SCMCHLR9  ;ALB/KCL - PCMM HL7 Reject Transmission Report Con't; 22-FEB-2000

 +1       ;;5.3;Scheduling;**210,284,297**;AUG 13,1993

 +2       ;

PRINT     ; Description: Used to print report.

 +1       ;

 +2       ;Init variables

 +3        NEW CRT,QUIT,PAGE,SUBSCRPT,SCARRAY

 +4        KILL SCARRAY

 +5        SET SCARRAY="SCERRSRT"

 +6        KILL ^TMP(SCARRAY,$JOB)

 +7        SET (QUIT,PAGE)=0

 +8        SET CRT=$SELECT($EXTRACT(IOST,1,2)="C-":1,1:0)

 +9       ;

 +10      ;Get PCMM HL7 Transmission Log errors

 +11       DO GET^SCMCHLR2(SCARRAY,$GET(SCRP("BEGIN")),$GET(SCRP("END")),$GET(SCRP("EPS")),$GET(SCRP("SORT")))

 +12      ;

 +13       USE IO

 +14       IF CRT

               IF PAGE=0

                   WRITE @IOF

 +15       SET PAGE=1

 +16       DO HEADER

 +17       DO PRINTERR($GET(SCRP("SORT")),$GET(SCRP("EPS")))

 +18       IF CRT

               IF 'QUIT

                   DO PAUSE

 +19       IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +20       DO ^%ZISC

 +21      ;

 +22       KILL ^TMP(SCARRAY,$JOB)

 +23       QUIT 

 +24      ;

LINE(LINE) ;

 +1       ; Description: Prints a line. First prints header if at end of page.

 +2       ;

 +3        IF CRT

               IF ($Y>(IOSL-4))

                   Begin DoDot:1

 +4                    DO PAUSE

 +5                    if QUIT

                           QUIT 

 +6                    WRITE @IOF

 +7                    DO HEADER

 +8                    WRITE LINE

                   End DoDot:1

 +9       ;

 +10      IF '$TEST

               IF ('CRT)

                   IF ($Y>(IOSL-2))

                       Begin DoDot:1

 +11                       WRITE @IOF

 +12                       DO HEADER

 +13                       WRITE LINE

                       End DoDot:1

 +14      ;

 +15      IF '$TEST

               WRITE !,LINE

 +16       QUIT 

 +17      ;

 +18      ;

HEADER    ; Description: Prints the report header.

 +1       ;

 +2        NEW LINE,X

 +3        IF $Y>1

               WRITE @IOF

 +4        WRITE !,"PCMM Transmission Error Report"

 +5        WRITE ?33,"Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT,"1P")

 +6        WRITE ?70,"Page ",PAGE

 +7        SET PAGE=PAGE+1

 +8        WRITE !

 +9        SET X=$GET(SCRP("SORT"))

 +10       WRITE !,"Sort By: "_$SELECT(X="N":"Patient Name",X="D":"Date Error Received",X="P":"Provider",1:"Unknown")

 +11       IF SCRP("BEGIN")

               Begin DoDot:1

 +12               WRITE ?40,"Date Range: "_$$FMTE^XLFDT(SCRP("BEGIN"))_" to "_$$FMTE^XLFDT($GET(SCRP("END")))

               End DoDot:1

 +13      IF '$TEST

               Begin DoDot:1

 +14               WRITE ?40,"Date Range: "_$$DRMSG^SCMCHLR1

               End DoDot:1

 +15       SET X=$GET(SCRP("EPS"))

 +16       WRITE !,"Error Processing Status: "_$SELECT(X=1:"New",X=2:"Checked",X=3:"New/Checked",1:"Unknown")

 +17       WRITE ?40,$$MRKMSG^SCMCHLR1

 +18       WRITE !

 +19      ;

 +20       WRITE !?2,"Patient Name",?23,"PATID",?31,"Date Rec",?42,"Provider",?63,"Type",?70,"EP Status"

 +21       SET $PIECE(LINE,"-",80)="-"

 +22       WRITE !,LINE,!

 +23       QUIT 

 +24      ;

 +25      ;

PAUSE     ; Description: Screen pause.  Sets QUIT=1 if user decides to quit.

 +1       ;

 +2        NEW DIR,X,Y

 +3        FOR 

               if $Y>(IOSL-3)

                   QUIT 

               WRITE !

 +4        SET DIR(0)="E"

 +5        DO ^DIR

 +6        IF ('(+Y))!$DATA(DIRUT)

               SET QUIT=1

 +7        QUIT 

 +8       ;

 +9       ;

PRINTERR(SCSORTBY,SCEPS) ; Description: Print list of errors.

 +1       ;

 +2       ;  Input:

 +3       ;   SCSORTBY - Sort by criteria

 +4       ;               N -> Patient Name

 +5       ;               D -> Date/Time Ack Received

 +6       ;               P -> Provider

 +7       ;      SCEPS -  Error processing status

 +8       ;

 +9       ; Output: None

 +10      ;

 +11       NEW DFN,SCSUB,SCLINE,SCTXT,SCTLIEN,SCERIEN,SCTLOG,SCPROV,SCTYPE

 +12      ;

 +13      ;Loop thru sort array by pat name, OR date ack rec'd, OR provider

 +14       SET SCSUB=$SELECT(SCSORTBY="N":"",SCSORTBY="P":"",1:0)

 +15       FOR 

               SET SCSUB=$ORDER(^TMP("SCERRSRT",$JOB,SCSORTBY,SCSUB))

               if SCSUB=""

                   QUIT 

               Begin DoDot:1

 +16      ;loop through PCMM HL7 Transmission Log ien(s)

 +17               SET SCTLIEN=0

 +18               FOR 

                       SET SCTLIEN=$ORDER(^TMP("SCERRSRT",$JOB,SCSORTBY,SCSUB,SCTLIEN))

                       if 'SCTLIEN

                           QUIT 

                       Begin DoDot:2

 +19      ;loop through Error Code subfile ien(s)

 +20                       SET SCERIEN=0

 +21                       FOR 

                               SET SCERIEN=$ORDER(^TMP("SCERRSRT",$JOB,SCSORTBY,SCSUB,SCTLIEN,SCERIEN))

                               if 'SCERIEN

                                   QUIT 

                               Begin DoDot:3

 +22      ;

 +23      ;get data for PCMM HL7 Trans Log entry

 +24                               IF $$GETLOG^SCMCHLA(SCTLIEN,SCERIEN,.SCTLOG)

                                       Begin DoDot:4

 +25      ;

 +26      ;set retransmit flag in line

 +27                                       SET SCLINE=$SELECT($GET(SCTLOG("STATUS"))="M":"*",1:" ")

 +28      ;

 +29      ;set patient name in line

 +30                                       SET SCTXT=$$LOWER^VALM1($SELECT($GET(SCTLOG("WORK")):"WORKLOAD",$GET(SCTLOG("DFN")):$PIECE($GET(^DPT(SCTLOG("DFN"),0)),"^",1),1:"UNKNOWN"))

 +31                                       SET SCLINE=SCLINE_" "_$$LJ(SCTXT,18)

 +32      ;

 +33      ;set patient id in line

 +34                                       SET DFN=+SCTLOG("DFN")

                                           DO PID^VADPT

 +35      ;D SET(SCARY,SCLINE,VA("BID"),SCCOL("PATID"),SCWID("PATID"),SCNUM,,,,.SCCNT)

 +36                                       SET SCLINE=SCLINE_"   "_$$LJ(VA("BID"),5)

 +37      ;

 +38      ;set date ack received in line

 +39                                       SET SCTXT=$$LOWER^VALM1($SELECT($GET(SCTLOG("ACK DT/TM")):$EXTRACT($$FDATE^VALM1(SCTLOG("ACK DT/TM")),1,8),1:"UNKNOWN"))

 +40                                       SET SCLINE=SCLINE_"   "_$$LJ(SCTXT,8)

 +41      ;

 +42      ;set provider in display in line

 +43                                       KILL SCHL

 +44                                       SET SCPROV=""

 +45      ;only get provider if ZPC segment error

 +46                                       IF $GET(SCTLOG("WORK"))

                                               SET SCPROV=$PIECE($GET(^SCPT(404.471,SCTLIEN,0)),U,8)

 +47                                       IF $GET(SCTLOG("ERR","SEG"))="ZPC"

                                               Begin DoDot:5

 +48                                               IF $$GETHL7ID^SCMCHLA2($GET(SCTLOG("ERR","ZPCID")),.SCHL)

 +49                                               SET SCPTR=$PIECE($GET(SCHL("HL7ID")),"-",2)

 +50                                               IF '$GET(SCTLOG("WORK"))

                                                       SET SCPROV=$PIECE($GET(^SCTM(404.52,+$GET(SCPTR),0)),"^",3)

                                               End DoDot:5

 +51                                       SET SCTXT=$$LOWER^VALM1($SELECT($GET(SCPROV)'="":$$EXTERNAL^DILFD(404.52,.03,,SCPROV),1:"N/A"))

 +52                                       SET SCLINE=SCLINE_"   "_$$LJ(SCTXT,18)

 +53      ;

 +54      ;set provider type in line

 +55                                       SET SCTYPE=$PIECE($GET(SCHL("HL7ID")),"-",4)

 +56                                       SET SCTXT=$SELECT(SCTYPE'="":SCTYPE,1:"N/A")

 +57                                       SET SCLINE=SCLINE_"   "_$$LJ(SCTXT,4)

 +58      ;

 +59      ;set error processing status in line

 +60                                       SET SCTXT=$$LOWER^VALM1($SELECT($GET(SCTLOG("ERR","EPS")):$$EXTERNAL^DILFD(404.47142,.06,,SCTLOG("ERR","EPS")),1:"UNKNOWN"))

 +61                                       SET SCLINE=SCLINE_"   "_$$LJ(SCTXT,7)

 +62      ;

 +63                                       DO LINE(SCLINE)

                                           if QUIT

                                               QUIT 

 +64      ;

 +65      ;set error code/desc in line

 +66                                       IF $$GETEC^SCMCHLA2($GET(SCTLOG("ERR","CODE")),.SCERR)

 +67                                       SET SCTXT="     Error: "_$SELECT($GET(SCERR("CODE"))'="":SCERR("CODE")_"-"_$GET(SCERR("SHORT")),1:$$LOWER^VALM1("UNKNOWN"))

 +68                                       SET SCLINE=$$LJ(SCTXT,80)

 +69                                       DO LINE(SCLINE)

                                           if QUIT

                                               QUIT 

                                       End DoDot:4

                               End DoDot:3

                               if QUIT

                                   QUIT 

                       End DoDot:2

                       if QUIT

                           QUIT 

               End DoDot:1

               if QUIT

                   QUIT 

 +70      ;

 +71       QUIT 

 +72      ;

 +73      ;

LJ(STRING,LENGTH) ;

 +1       ;

 +2        QUIT $$LJ^XLFSTR($EXTRACT(STRING,1,LENGTH),LENGTH)