PSN571PI.m

PSN571PI ;BIR/MFR-Post-install routine for Patch PSN*4*571 ; 27 Oct 2020 8:40 AM

 ;;4.0;NATIONAL DRUG FILE;**571**; 30 Oct 98;Build 5

 ;

EN ; entry point

 D BMES^XPDUTL(" Starting post-install for PSN*4*571...")

 K ^XTMP("PSN571PI")

 S ^XTMP("PSN571PI",0)=$$FMADD^XLFDT($$NOW^XLFDT(),365)_"^"_$$NOW^XLFDT()_"^PSN*4*571 - CORRUPTED RECORDS REMOVED FROM VA PRODUCT FILE (#50.68)"

 ;

 N VAPRD,VAGEN,DOSFRM,DRGUNT,Z,DIK,DA,CNT

 S CNT=0,VAPRD=32900,DIK="^PSNDF(50.68,"

 F  S VAPRD=$O(^PSNDF(50.68,VAPRD)) Q:'VAPRD  D

 . S Z=$G(^PSNDF(50.68,VAPRD,0))

 . S VAGEN=$P(Z,"^",2) I VAGEN'="",VAGEN?.N,$D(^PSNDF(50.6,VAGEN,0)) Q     ; Pointer to VA GENERIC #50.6

 . S DOSFRM=$P(Z,"^",3) I DOSFRM'="",DOSFRM?.N,$D(^PS(50.606,DOSFRM,0)) Q  ; Pointer to DOSAGE FORM #50.606

 . S DRGUNT=$P(Z,"^",5) I DRGUNT'="",DRGUNT?.N,$D(^PS(50.607,DRGUNT,0)) Q  ; Pointer to DRUG UNIT #50.607

 . M ^XTMP("PSN571PI",VAPRD)=^PSNDF(50.68,VAPRD)

 . S DA=VAPRD D ^DIK S CNT=CNT+1

 D BMES^XPDUTL(" "_$S('CNT:"No",1:CNT)_" corrupted records found/removed from the VA PRODUCT file (#50.68).")

 ;

 D BMES^XPDUTL(" Finished post-install for PSN*4*571.")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSN571PI   1139     printed  Apr 09, 2024@21:26:27                                                                                                                                                                                                    Page 2

PSN571PI  ;BIR/MFR-Post-install routine for Patch PSN*4*571 ; 27 Oct 2020 8:40 AM

 +1       ;;4.0;NATIONAL DRUG FILE;**571**; 30 Oct 98;Build 5

 +2       ;

EN        ; entry point

 +1        DO BMES^XPDUTL(" Starting post-install for PSN*4*571...")

 +2        KILL ^XTMP("PSN571PI")

 +3        SET ^XTMP("PSN571PI",0)=$$FMADD^XLFDT($$NOW^XLFDT(),365)_"^"_$$NOW^XLFDT()_"^PSN*4*571 - CORRUPTED RECORDS REMOVED FROM VA PRODUCT FILE (#50.68)"

 +4       ;

 +5        NEW VAPRD,VAGEN,DOSFRM,DRGUNT,Z,DIK,DA,CNT

 +6        SET CNT=0

           SET VAPRD=32900

           SET DIK="^PSNDF(50.68,"

 +7        FOR 

               SET VAPRD=$ORDER(^PSNDF(50.68,VAPRD))

               if 'VAPRD

                   QUIT 

               Begin DoDot:1

 +8                SET Z=$GET(^PSNDF(50.68,VAPRD,0))

 +9       ; Pointer to VA GENERIC #50.6

                   SET VAGEN=$PIECE(Z,"^",2)

                   IF VAGEN'=""

                       IF VAGEN?.N

                           IF $DATA(^PSNDF(50.6,VAGEN,0))

                               QUIT 

 +10      ; Pointer to DOSAGE FORM #50.606

                   SET DOSFRM=$PIECE(Z,"^",3)

                   IF DOSFRM'=""

                       IF DOSFRM?.N

                           IF $DATA(^PS(50.606,DOSFRM,0))

                               QUIT 

 +11      ; Pointer to DRUG UNIT #50.607

                   SET DRGUNT=$PIECE(Z,"^",5)

                   IF DRGUNT'=""

                       IF DRGUNT?.N

                           IF $DATA(^PS(50.607,DRGUNT,0))

                               QUIT 

 +12               MERGE ^XTMP("PSN571PI",VAPRD)=^PSNDF(50.68,VAPRD)

 +13               SET DA=VAPRD

                   DO ^DIK

                   SET CNT=CNT+1

               End DoDot:1

 +14       DO BMES^XPDUTL(" "_$SELECT('CNT:"No",1:CNT)_" corrupted records found/removed from the VA PRODUCT file (#50.68).")

 +15      ;

 +16       DO BMES^XPDUTL(" Finished post-install for PSN*4*571.")

 +17       QUIT