SC40447P.m

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.

 Q

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

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SC40447P   799     printed  Apr 09, 2024@22:02:06                                                                                                                                                                                                     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