PRCA307P.m

PRCA307P ;ALB/BDB - PATCH PRCA*4.5*307 POST-INSTALL ROUTINE ; 11/2/15 4:15pm

 ;;4.5;Accounts Receivable;**307**;Mar 20, 1995;Build 80

 ;;Per VA Directive 6402, this routine should not be modified.

 ; This routine will update a specific list of Station ID's

 ; and queues the Patient Statement Auto-Correction Program

 ;

 Q

EN ;Entry point for PRCA*4.5*307 post-install

 N SDAY,SITE,T

 S SITE=$$SITE^RCMSITE

 I SITE=0 D

 .D MES^XPDUTL(" ")

 .D BMES^XPDUTL(">>> WARNING! STATION ID NOT FOUND!")

 .D MES^XPDUTL(">>> THE PATIENT STATEMENT TRANSMISSION DATE WILL NOT BE UPDATED")

 .D MES^XPDUTL(" ")

 I SITE'=0,$T(@SITE) D

 .D MES^XPDUTL(" ")

 .D BMES^XPDUTL(">>> STATION ID "_SITE_" MATCH FOUND!")

 .D MES^XPDUTL(">>> THE PATIENT STATEMENT TRANSMISSION DATE WILL BE UPDATED")

 .D MES^XPDUTL(" ")

 .;set patient statement day to site statement day

 .S T=$T(@SITE),SDAY=+$P(T,";;",2)

 .S $P(^RC(342,1,0),"^",11)=SDAY

 .S DEB=0 F  S DEB=$O(^RCD(340,"AB","DPT(",DEB)) Q:'DEB  I $D(^RCD(340,+DEB,0)) D

 ..S STDT=$P($G(^RCD(340,+DEB,0)),"^",3) Q:'STDT

 ..S SSTDT=$P($G(^RC(342,1,0)),"^",11)

 ..Q:(SSTDT=STDT)

 ..K ^RCD(340,"AC",STDT,+DEB)

 ..S $P(^RCD(340,+DEB,0),"^",3)=SSTDT

 ..S ^RCD(340,"AC",SSTDT,DEB)=""

 K SDAY,SITE,DEB,STDT,SSTDT,T

 ;

 ;Stations that will have monthly statement build date changed

438 ;;21^SIOUX FALLS,SD

501 ;;21^ALBUQUERQUE,NM

504 ;;21^AMARILLO,TX

542 ;;21^COATESVILLE,PA

562 ;;21^ERIE,PA

568 ;;21^FORT MEADE,SD

649 ;;21^PRESCOTT,AZ

656 ;;21^ST. CLOUD,MN

688 ;;21^WASHINGTON,DC

756 ;;21^EL PASO,TX

565 ;;22^FAYETTEVILLE,NC

621 ;;22^MOUNTAIN HOME,TN

658 ;;22^SALEM,VA

664 ;;22^SAN DIEGO,CA

671 ;;22^SAN ANTONIO,TX

689 ;;22^WEST HAVEN,CT

740 ;;22^TEXAS VALLEY COASTAL,TX

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCA307P   1736     printed  Apr 09, 2024@20:46:50                                                                                                                                                                                                    Page 2

PRCA307P  ;ALB/BDB - PATCH PRCA*4.5*307 POST-INSTALL ROUTINE ; 11/2/15 4:15pm

 +1       ;;4.5;Accounts Receivable;**307**;Mar 20, 1995;Build 80

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ; This routine will update a specific list of Station ID's

 +4       ; and queues the Patient Statement Auto-Correction Program

 +5       ;

 +6        QUIT 

EN        ;Entry point for PRCA*4.5*307 post-install

 +1        NEW SDAY,SITE,T

 +2        SET SITE=$$SITE^RCMSITE

 +3        IF SITE=0

               Begin DoDot:1

 +4                DO MES^XPDUTL(" ")

 +5                DO BMES^XPDUTL(">>> WARNING! STATION ID NOT FOUND!")

 +6                DO MES^XPDUTL(">>> THE PATIENT STATEMENT TRANSMISSION DATE WILL NOT BE UPDATED")

 +7                DO MES^XPDUTL(" ")

               End DoDot:1

 +8        IF SITE'=0

               IF $TEXT(@SITE)

                   Begin DoDot:1

 +9                    DO MES^XPDUTL(" ")

 +10                   DO BMES^XPDUTL(">>> STATION ID "_SITE_" MATCH FOUND!")

 +11                   DO MES^XPDUTL(">>> THE PATIENT STATEMENT TRANSMISSION DATE WILL BE UPDATED")

 +12                   DO MES^XPDUTL(" ")

 +13      ;set patient statement day to site statement day

 +14                   SET T=$TEXT(@SITE)

                       SET SDAY=+$PIECE(T,";;",2)

 +15                   SET $PIECE(^RC(342,1,0),"^",11)=SDAY

 +16                   SET DEB=0

                       FOR 

                           SET DEB=$ORDER(^RCD(340,"AB","DPT(",DEB))

                           if 'DEB

                               QUIT 

                           IF $DATA(^RCD(340,+DEB,0))

                               Begin DoDot:2

 +17                               SET STDT=$PIECE($GET(^RCD(340,+DEB,0)),"^",3)

                                   if 'STDT

                                       QUIT 

 +18                               SET SSTDT=$PIECE($GET(^RC(342,1,0)),"^",11)

 +19                               if (SSTDT=STDT)

                                       QUIT 

 +20                               KILL ^RCD(340,"AC",STDT,+DEB)

 +21                               SET $PIECE(^RCD(340,+DEB,0),"^",3)=SSTDT

 +22                               SET ^RCD(340,"AC",SSTDT,DEB)=""

                               End DoDot:2

                   End DoDot:1

 +23       KILL SDAY,SITE,DEB,STDT,SSTDT,T

 +24      ;

 +25      ;Stations that will have monthly statement build date changed

438       ;;21^SIOUX FALLS,SD

501       ;;21^ALBUQUERQUE,NM

504       ;;21^AMARILLO,TX

542       ;;21^COATESVILLE,PA

562       ;;21^ERIE,PA

568       ;;21^FORT MEADE,SD

649       ;;21^PRESCOTT,AZ

656       ;;21^ST. CLOUD,MN

688       ;;21^WASHINGTON,DC

756       ;;21^EL PASO,TX

565       ;;22^FAYETTEVILLE,NC

621       ;;22^MOUNTAIN HOME,TN

658       ;;22^SALEM,VA

664       ;;22^SAN DIEGO,CA

671       ;;22^SAN ANTONIO,TX

689       ;;22^WEST HAVEN,CT

740       ;;22^TEXAS VALLEY COASTAL,TX