Routine: SC40447P

SC40447P ;BP-CIOFO/TEH CROSS-REFERENCE REPAIR UTILITY ; 28 Apr 04  04:11PM

        ;;5.3;Scheduling;**365**;Apr 28 2004

;;

;;

 ;;This utility will verify that in the PCMM HL7 TRANSMISSION LOG

 ;;file that if the 'ACK RECIEVED DATE/TIME" field is set and the

 ;;STATUS file does not have a "A" for accepted then a correct will

 ;;be done to the STATUS field and the "ASTAT" x-ref will be corrected.

;;

 ;;This routine should not be run while transmitting PCMM HL7 data.

EN N SCX,SCACKDT,DA,DR,SCXX,DIE

 S SCX="" F  S SCX=$O(^SCPT(404.471,"ASTAT","T",SCX)) Q:SCX<1  D

 .S SCXX=$G(^SCPT(404.471,SCX,0)) Q:SCXX=""

 .;CHECK FOR ACK RECIEVED DATE/TIME

 .S SCACKDT=$P(SCXX,"^",5) Q:'SCACKDT  D

 ..;CORRECT STATUS AND X-REF

 ..S DIE="^SCPT(404.471,",DA=SCX,DR=".04////A" D ^DIE

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSC40447P   799     printed  Mar 13, 2025@21:42:34                                                                                                                                                                                                     Page 2

SC40447P  ;BP-CIOFO/TEH CROSS-REFERENCE REPAIR UTILITY ; 28 Apr 04  04:11PM

 +1       ;;5.3;Scheduling;**365**;Apr 28 2004

 +2       ;;

 +3       ;;

 +4       ;;This utility will verify that in the PCMM HL7 TRANSMISSION LOG

 +5       ;;file that if the 'ACK RECIEVED DATE/TIME" field is set and the

 +6       ;;STATUS file does not have a "A" for accepted then a correct will

 +7       ;;be done to the STATUS field and the "ASTAT" x-ref will be corrected.

 +8       ;;

 +9       ;;This routine should not be run while transmitting PCMM HL7 data.

 +10       QUIT

EN         NEW SCX,SCACKDT,DA,DR,SCXX,DIE

 +1        SET SCX=""

FOR

               SET SCX=$ORDER(^SCPT(404.471,"ASTAT","T",SCX))

               if SCX<1

                   QUIT

               Begin DoDot:1

 +2                SET SCXX=$GET(^SCPT(404.471,SCX,0))

                   if SCXX=""

                       QUIT

 +3       ;CHECK FOR ACK RECIEVED DATE/TIME

 +4                SET SCACKDT=$PIECE(SCXX,"^",5)

                   if 'SCACKDT

                       QUIT

                   Begin DoDot:2

 +5       ;CORRECT STATUS AND X-REF

 +6                    SET DIE="^SCPT(404.471,"

                       SET DA=SCX

                       SET DR=".04////A"

                       DO ^DIE

                   End DoDot:2

               End DoDot:1

 +7        QUIT

SC40447P.m