PSS243PI.m

PSS243PI ;BIR/MFR - Post-install routine for patch PSS*1*243 ; 02 Feb 2020  10:06 AM

 ;;1.0;PHARMACY DATA MANAGEMENT;**243**;9/30/97;Build 3

 ;

EN ; Post-install Entry Point

 ; Kills and Rebuils AND, APN and APR

 N XREF,DRUG,NDNODE,VAGENIEN,VAPRDIEN,PRIMDRG

 ; Killing off entire x-ref nodes before rebuilding it

 D BMES^XPDUTL("Killing 'AND', 'APN' and 'APR' cross-referenes...")

 F XREF="AND","APN","APR" K ^PSDRUG(XREF)

 H 3 D BMES^XPDUTL("Done!")

 ;Re-Building x-ref nodes

 D BMES^XPDUTL("Re-building 'AND', 'APN' and 'APR' cross-referenes...")

 S DRUG=0 F  S DRUG=$O(^PSDRUG(DRUG)) Q:'DRUG  D

 . I '$D(^PSDRUG(DRUG,"ND")) Q

 . S NDNODE=$G(^PSDRUG(DRUG,"ND"))

 . S VAGENIEN=$P(NDNODE,"^",1)                 ; VA GENERIC (#50.6) Pointer

 . S VAPRDIEN=$P(NDNODE,"^",3)                 ; VA PRODUCT (#50.68) Pointer

 . S PRIMDRG=$P($G(^PSDRUG(DRUG,2)),"^",6)     ; PRIMARY DRUG (#50.3) Pointer

 . I PRIMDRG,VAPRDIEN,VAGENIEN S ^PSDRUG("APN",PRIMDRG,VAGENIEN_"A"_VAPRDIEN,DRUG)=""

 . I VAGENIEN S ^PSDRUG("AND",VAGENIEN,DRUG)=""

 . I VAPRDIEN S ^PSDRUG("APR",VAPRDIEN,DRUG)=""

 H 3 D BMES^XPDUTL("Done!")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSS243PI   1131     printed  Apr 09, 2024@21:35:05                                                                                                                                                                                                    Page 2

PSS243PI  ;BIR/MFR - Post-install routine for patch PSS*1*243 ; 02 Feb 2020  10:06 AM

 +1       ;;1.0;PHARMACY DATA MANAGEMENT;**243**;9/30/97;Build 3

 +2       ;

EN        ; Post-install Entry Point

 +1       ; Kills and Rebuils AND, APN and APR

 +2        NEW XREF,DRUG,NDNODE,VAGENIEN,VAPRDIEN,PRIMDRG

 +3       ; Killing off entire x-ref nodes before rebuilding it

 +4        DO BMES^XPDUTL("Killing 'AND', 'APN' and 'APR' cross-referenes...")

 +5        FOR XREF="AND","APN","APR"

               KILL ^PSDRUG(XREF)

 +6        HANG 3

           DO BMES^XPDUTL("Done!")

 +7       ;Re-Building x-ref nodes

 +8        DO BMES^XPDUTL("Re-building 'AND', 'APN' and 'APR' cross-referenes...")

 +9        SET DRUG=0

           FOR 

               SET DRUG=$ORDER(^PSDRUG(DRUG))

               if 'DRUG

                   QUIT 

               Begin DoDot:1

 +10               IF '$DATA(^PSDRUG(DRUG,"ND"))

                       QUIT 

 +11               SET NDNODE=$GET(^PSDRUG(DRUG,"ND"))

 +12      ; VA GENERIC (#50.6) Pointer

                   SET VAGENIEN=$PIECE(NDNODE,"^",1)

 +13      ; VA PRODUCT (#50.68) Pointer

                   SET VAPRDIEN=$PIECE(NDNODE,"^",3)

 +14      ; PRIMARY DRUG (#50.3) Pointer

                   SET PRIMDRG=$PIECE($GET(^PSDRUG(DRUG,2)),"^",6)

 +15               IF PRIMDRG

                       IF VAPRDIEN

                           IF VAGENIEN

                               SET ^PSDRUG("APN",PRIMDRG,VAGENIEN_"A"_VAPRDIEN,DRUG)=""

 +16               IF VAGENIEN

                       SET ^PSDRUG("AND",VAGENIEN,DRUG)=""

 +17               IF VAPRDIEN

                       SET ^PSDRUG("APR",VAPRDIEN,DRUG)=""

               End DoDot:1

 +18       HANG 3

           DO BMES^XPDUTL("Done!")

 +19       QUIT