Routine: PSSNDSU

PSSNDSU ;DAL/JCH - MEDS DOSAGE FORM NDS UTILITIES ;09/07/2017

 ;;1.0;PHARMACY DATA MANAGEMENT;**211**;9/30/97;Build 20

QUE ; Task off to run in background

 N ZTRTN,ZTDESC,ZTDTH

 S ZTRTN="EN^PSSNDSU"

 S ZTDESC="Medications Dosage Form NDS Master File Associations"

 S ZTDTH=$$NOW^XLFDT

 S ZTIO=""

 D ^%ZTLOAD

EN ; Update Meds Dosage Form pointers to MASTER file

 N PSSFL,XUMF

 S XUMF=1

 S PSSFL=$P($T(FILE+1),";",3)

 Q:'$G(PSSFL)

 ;  MASTER <concept> field (#90) in <concept> file points to MASTER <concept> file

 D UPDATE(PSSFL)

UPDATE(OFILE) ; Update MASTER FILE multiple (#90) field pointers in legacy file (OFILE).

 ; Check ASSOCIATED VA <concept> field (#90) in MASTER file, add pointers in OFILE to MASTER file.

 D SCANM(OFILE)

 ; Check pointers to MASTER file in OFILE, remove pointers if MASTER file entry doesn't exist.

 D SCANO(OFILE)

SCANM(OFILE) ; Get ASSOCIATED VA <concept> field (#99) values from MASTER file MFILE, update pointers in OFILE

 N ASSOC,MIEN,MGLO,MERR,MFILE,OFILIEN

 D FIELD^DID(OFILE,90,"","POINTER","MGLO","MERR")      ; Get global name and related MASTER file of OFILE

 S MGLO="^"_$G(MGLO("POINTER"))                        ; MASTER file global

 S MFILE=+$P(MGLO,"(",2)                               ; MASTER file number

 S ASSOC="" F  S ASSOC=$O(@(MGLO_"""AC"",ASSOC)")) Q:ASSOC=""  D      ; ASSOCIATED VA <concept> multiple (#99)

 .S MIEN=0 F  S MIEN=$O(@(MGLO_"""AC"",ASSOC,MIEN)")) Q:'MIEN  D

 ..S OFILIEN=$$FIND1^DIC(OFILE,,"O",ASSOC,,,"PSERR")

 ..Q:'$G(OFILIEN)

 ..D UPDPTR(ASSOC,MIEN,"ADD",OFILE)

SCANO(OFILE) ; Get MASTER <concept> field (#90) values from legacy file OFILE, verify pointing to actual MASTER entry

 N OFILIEN,OGLO,OERR,MPTR,MFILE,MGLO,PSIEN

 D FILE^DID(OFILE,"","GLOBAL NAME","OGLO","OERR")   ; Get global name for OFILE

 S OGLO=$G(OGLO("GLOBAL NAME"))

 D FIELD^DID(OFILE,90,"","POINTER","MGLO","MERR")   ; Get MASTER <concept> file global name and file number

 S MGLO="^"_$G(MGLO("POINTER"))

 S MFILE=+$P(MGLO,"(",2)

 S OFILIEN=0 F  S OFILIEN=$O(@(OGLO_OFILIEN_")")) Q:'OFILIEN  D   ; Loop through pointers to MASTER file field (#90)

 .S MPTR=$G(@(OGLO_OFILIEN_","_"""MASTER"")")) Q:'MPTR

 .N PSSRSLT,ONAME,MNAME,MFILESUB,PSSERR

 .D FIND^DIC(OFILE,,"@;.01","A",OFILIEN,,,,,"PSSRSLT","PSSERR")

 .S ONAME=$G(PSSRSLT("DILIST","ID",1,.01))

 .K PSSRSLT

 .D FIND^DIC(MFILE,,"@;.01","A",MPTR,,,,,"PSSRSLT","PSSERR")

 .S MNAME=$G(PSSRSLT("DILIST","ID",1,.01))

 .S MFILESUB=MFILE_901

 .K PSSRSLT

 .D FIND^DIC(MFILESUB,","_MPTR_",",".01","",ONAME,,,,,"PSSRSLT","PSSERROR")

 .I '$G(PSSRSLT("DILIST",2,1)) D UPDPTR(ONAME,MPTR,"DEL",OFILE)

UPDPTR(PSSVANAM,PSSMIEN,PSSACT,PSSFILE) ; Update MASTER VA <concept> field (#90) in <concept> file

 ; anytime the ASSOCIATED VA <concept>(S) field (#99) in the MASTER <concept> file (#50.60699) is updated.

 ;  PSSVANAM   : Name of ASSOCIATED VA <concept> from local <concept> file

 ;   PSSFILE   : The VA File Number (#50.606) that points to the MASTER file (#50.60699)

 ;   PSSMIEN   : IEN of the entry in the MASTER <concept> (#50.60699) file.

 ;   PSSACT    : Action to perform on MASTER <concept> (#90) multiple in <concept> file (#50.606):

 ;                 "ADD"  = Add a pointer to the PSSMIEN entry in MASTER <concept>  file (#50.60699), if it doesn't already exist

 ;                 "DEL"  = Delete pointer to the PSSMIEN entry in MASTER <concept> file (#50.60699), if it exists

 N PSSMFILE   ; MASTER <concept> file (#50.60699), retrieved from "MASTER <concept>" field (#90) in <concept> file (#50.606)

 N PSSMGLO    ; Data global for MASTER <concept> file (#50.60699)

 N PSSGLO     ; Data global for legacy <concept) file (#50.606)

 N PSSMSUB    ; MASTER <concept> file's (#50.60699) ASSOCATED VA <concepts> field's (#99) SUB-FILE number. (#50.60699901)

 N PSSFDA     ; FDA_ROOT array for FILE^DIE call.

 N PSSERR     ; Error returned by FILE^DIE call. Not used, provided for maintenance/troubleshooting.

 N PSSVAIEN   ; The IEN(s) in the <concept> file (#50.606), whose MASTER <concept> multiple (#90) is being updated by this routine.

 N PSSVAMPTR  ; The current value of the MASTER <concept> file (#50.60699) multiple (#90) in the <concept> file (#50.606), pointing to MASTER <concept> (#50.60699)

 N PSSVANAMS  ; <concept> (#50.606) file NAME (.01) value truncated to 30 characters to check "B" x-ref, which only contains max of 30 chars.

 N PSSIEN     ; Internal Entry Number (IEN) of local file (#50.606)

 Q:'PSSMIEN!'$L(PSSVANAM)!'$L(PSSACT)!'$G(PSSFILE)

 S PSSVANAMS=$E(PSSVANAM,1,30)

 ; Get MASTER <concept> file number and data global. File number must be 50.60699 (MASTER DOSAGE FORM)

 ; Get data global reference

 D FIELD^DID(PSSFILE,90,"","POINTER","PSSMGLO","PSSERR")

 S PSSMGLO="^"_$G(PSSMGLO("POINTER"))

 S PSSMFILE=+$P(PSSMGLO,"(",2)

 Q:(",50.60699,")'[(","_PSSMFILE_",")

 D FILE^DID(PSSFILE,"N","GLOBAL NAME","PSSGLO","PSSERR")

 S PSSGLO=$G(PSSGLO("GLOBAL NAME"))

 ; Get MASTER <concept> file's ASSOCATED VA <concepts> field's (#99) SUB-FILE number. Must be 50.60699901

 S PSSMSUB=PSSMFILE_"901"

 Q:(",50.60699901,")'[(","_PSSMSUB_",")

 ; Search for and delete old MASTER <concept> (#90) field entries from <concept> file (#50.606) that are being replaced

 S PSSIEN=0 F  S PSSIEN=$O(@(PSSGLO_"""B"",PSSVANAM,PSSIEN)")) Q:'PSSIEN  D

 .I PSSACT="ADD" D  Q

 ..I $G(@(PSSGLO_"PSSIEN,""MASTER"")"))=PSSMIEN Q   ; Already there, don't file duplicate entry.

 ..S PSSFDA(PSSFILE,PSSIEN_",",90)=+PSSMIEN

 ..D FILE^DIE("","PSSFDA","PSSERR")

 .I PSSACT="DEL" D  Q     ;   Delete the MASTER <concept> (#90) field pointer from <concept> file (#50.606) entry PSSVAIEN

 ..Q:'$G(PSSIEN)

 ..S PSSFDA(PSSFILE,PSSIEN_",",90)="@"

 ..D FILE^DIE("","PSSFDA","PSSERR")

FILE ; File to be updated

 ;;50.606

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSNDSU   5881     printed  Mar 13, 2025@21:37:48                                                                                                                                                                                                     Page 2

PSSNDSU   ;DAL/JCH - MEDS DOSAGE FORM NDS UTILITIES ;09/07/2017

 +1       ;;1.0;PHARMACY DATA MANAGEMENT;**211**;9/30/97;Build 20

 +2       ;

 +3        QUIT

 +4       ;

QUE       ; Task off to run in background

 +1        NEW ZTRTN,ZTDESC,ZTDTH

 +2       ;

 +3        SET ZTRTN="EN^PSSNDSU"

 +4        SET ZTDESC="Medications Dosage Form NDS Master File Associations"

 +5        SET ZTDTH=$$NOW^XLFDT

 +6        SET ZTIO=""

 +7       ;

 +8        DO ^%ZTLOAD

 +9        QUIT

 +10      ;

EN        ; Update Meds Dosage Form pointers to MASTER file

 +1        NEW PSSFL,XUMF

 +2        SET XUMF=1

 +3        SET PSSFL=$PIECE($TEXT(FILE+1),";",3)

 +4        if '$GET(PSSFL)

               QUIT

 +5       ;  MASTER <concept> field (#90) in <concept> file points to MASTER <concept> file

 +6        DO UPDATE(PSSFL)

 +7        QUIT

 +8       ;

UPDATE(OFILE) ; Update MASTER FILE multiple (#90) field pointers in legacy file (OFILE).

 +1       ; Check ASSOCIATED VA <concept> field (#90) in MASTER file, add pointers in OFILE to MASTER file.

 +2        DO SCANM(OFILE)

 +3       ; Check pointers to MASTER file in OFILE, remove pointers if MASTER file entry doesn't exist.

 +4        DO SCANO(OFILE)

 +5        QUIT

 +6       ;

SCANM(OFILE) ; Get ASSOCIATED VA <concept> field (#99) values from MASTER file MFILE, update pointers in OFILE

 +1        NEW ASSOC,MIEN,MGLO,MERR,MFILE,OFILIEN

 +2       ; Get global name and related MASTER file of OFILE

           DO FIELD^DID(OFILE,90,"","POINTER","MGLO","MERR")

 +3       ; MASTER file global

           SET MGLO="^"_$GET(MGLO("POINTER"))

 +4       ; MASTER file number

           SET MFILE=+$PIECE(MGLO,"(",2)

 +5       ; ASSOCIATED VA <concept> multiple (#99)

           SET ASSOC=""

FOR

               SET ASSOC=$ORDER(@(MGLO_"""AC"",ASSOC)"))

               if ASSOC=""

                   QUIT

               Begin DoDot:1

 +6                SET MIEN=0

FOR

                       SET MIEN=$ORDER(@(MGLO_"""AC"",ASSOC,MIEN)"))

                       if 'MIEN

                           QUIT

                       Begin DoDot:2

 +7                        SET OFILIEN=$$FIND1^DIC(OFILE,,"O",ASSOC,,,"PSERR")

 +8                        if '$GET(OFILIEN)

                               QUIT

 +9                        DO UPDPTR(ASSOC,MIEN,"ADD",OFILE)

                       End DoDot:2

               End DoDot:1

 +10       QUIT

 +11      ;

SCANO(OFILE) ; Get MASTER <concept> field (#90) values from legacy file OFILE, verify pointing to actual MASTER entry

 +1        NEW OFILIEN,OGLO,OERR,MPTR,MFILE,MGLO,PSIEN

 +2       ; Get global name for OFILE

           DO FILE^DID(OFILE,"","GLOBAL NAME","OGLO","OERR")

 +3        SET OGLO=$GET(OGLO("GLOBAL NAME"))

 +4       ; Get MASTER <concept> file global name and file number

           DO FIELD^DID(OFILE,90,"","POINTER","MGLO","MERR")

 +5        SET MGLO="^"_$GET(MGLO("POINTER"))

 +6        SET MFILE=+$PIECE(MGLO,"(",2)

 +7       ; Loop through pointers to MASTER file field (#90)

           SET OFILIEN=0

FOR

               SET OFILIEN=$ORDER(@(OGLO_OFILIEN_")"))

               if 'OFILIEN

                   QUIT

               Begin DoDot:1

 +8                SET MPTR=$GET(@(OGLO_OFILIEN_","_"""MASTER"")"))

                   if 'MPTR

                       QUIT

 +9                NEW PSSRSLT,ONAME,MNAME,MFILESUB,PSSERR

 +10               DO FIND^DIC(OFILE,,"@;.01","A",OFILIEN,,,,,"PSSRSLT","PSSERR")

 +11               SET ONAME=$GET(PSSRSLT("DILIST","ID",1,.01))

 +12               KILL PSSRSLT

 +13               DO FIND^DIC(MFILE,,"@;.01","A",MPTR,,,,,"PSSRSLT","PSSERR")

 +14               SET MNAME=$GET(PSSRSLT("DILIST","ID",1,.01))

 +15               SET MFILESUB=MFILE_901

 +16               KILL PSSRSLT

 +17               DO FIND^DIC(MFILESUB,","_MPTR_",",".01","",ONAME,,,,,"PSSRSLT","PSSERROR")

 +18               IF '$GET(PSSRSLT("DILIST",2,1))

                       DO UPDPTR(ONAME,MPTR,"DEL",OFILE)

               End DoDot:1

 +19       QUIT

 +20      ;

UPDPTR(PSSVANAM,PSSMIEN,PSSACT,PSSFILE) ; Update MASTER VA <concept> field (#90) in <concept> file

 +1       ; anytime the ASSOCIATED VA <concept>(S) field (#99) in the MASTER <concept> file (#50.60699) is updated.

 +2       ;  PSSVANAM   : Name of ASSOCIATED VA <concept> from local <concept> file

 +3       ;   PSSFILE   : The VA File Number (#50.606) that points to the MASTER file (#50.60699)

 +4       ;   PSSMIEN   : IEN of the entry in the MASTER <concept> (#50.60699) file.

 +5       ;   PSSACT    : Action to perform on MASTER <concept> (#90) multiple in <concept> file (#50.606):

 +6       ;                 "ADD"  = Add a pointer to the PSSMIEN entry in MASTER <concept>  file (#50.60699), if it doesn't already exist

 +7       ;                 "DEL"  = Delete pointer to the PSSMIEN entry in MASTER <concept> file (#50.60699), if it exists

 +8       ; MASTER <concept> file (#50.60699), retrieved from "MASTER <concept>" field (#90) in <concept> file (#50.606)

           NEW PSSMFILE

 +9       ; Data global for MASTER <concept> file (#50.60699)

           NEW PSSMGLO

 +10      ; Data global for legacy <concept) file (#50.606)

           NEW PSSGLO

 +11      ; MASTER <concept> file's (#50.60699) ASSOCATED VA <concepts> field's (#99) SUB-FILE number. (#50.60699901)

           NEW PSSMSUB

 +12      ; FDA_ROOT array for FILE^DIE call.

           NEW PSSFDA

 +13      ; Error returned by FILE^DIE call. Not used, provided for maintenance/troubleshooting.

           NEW PSSERR

 +14      ; The IEN(s) in the <concept> file (#50.606), whose MASTER <concept> multiple (#90) is being updated by this routine.

           NEW PSSVAIEN

 +15      ; The current value of the MASTER <concept> file (#50.60699) multiple (#90) in the <concept> file (#50.606), pointing to MASTER <concept> (#50.60699)

           NEW PSSVAMPTR

 +16      ; <concept> (#50.606) file NAME (.01) value truncated to 30 characters to check "B" x-ref, which only contains max of 30 chars.

           NEW PSSVANAMS

 +17      ; Internal Entry Number (IEN) of local file (#50.606)

           NEW PSSIEN

 +18      ;

 +19       if 'PSSMIEN!'$LENGTH(PSSVANAM)!'$LENGTH(PSSACT)!'$GET(PSSFILE)

               QUIT

 +20       SET PSSVANAMS=$EXTRACT(PSSVANAM,1,30)

 +21      ;

 +22      ; Get MASTER <concept> file number and data global. File number must be 50.60699 (MASTER DOSAGE FORM)

 +23      ; Get data global reference

 +24       DO FIELD^DID(PSSFILE,90,"","POINTER","PSSMGLO","PSSERR")

 +25       SET PSSMGLO="^"_$GET(PSSMGLO("POINTER"))

 +26       SET PSSMFILE=+$PIECE(PSSMGLO,"(",2)

 +27       if (",50.60699,")'[(","_PSSMFILE_",")

               QUIT

 +28      ;

 +29       DO FILE^DID(PSSFILE,"N","GLOBAL NAME","PSSGLO","PSSERR")

 +30       SET PSSGLO=$GET(PSSGLO("GLOBAL NAME"))

 +31      ;

 +32      ; Get MASTER <concept> file's ASSOCATED VA <concepts> field's (#99) SUB-FILE number. Must be 50.60699901

 +33       SET PSSMSUB=PSSMFILE_"901"

 +34       if (",50.60699901,")'[(","_PSSMSUB_",")

               QUIT

 +35      ; Search for and delete old MASTER <concept> (#90) field entries from <concept> file (#50.606) that are being replaced

 +36       SET PSSIEN=0

FOR

               SET PSSIEN=$ORDER(@(PSSGLO_"""B"",PSSVANAM,PSSIEN)"))

               if 'PSSIEN

                   QUIT

               Begin DoDot:1

 +37               IF PSSACT="ADD"

                       Begin DoDot:2

 +38      ; Already there, don't file duplicate entry.

                           IF $GET(@(PSSGLO_"PSSIEN,""MASTER"")"))=PSSMIEN

                               QUIT

 +39                       SET PSSFDA(PSSFILE,PSSIEN_",",90)=+PSSMIEN

 +40                       DO FILE^DIE("","PSSFDA","PSSERR")

                       End DoDot:2

                       QUIT

 +41      ;   Delete the MASTER <concept> (#90) field pointer from <concept> file (#50.606) entry PSSVAIEN

                   IF PSSACT="DEL"

                       Begin DoDot:2

 +42                       if '$GET(PSSIEN)

                               QUIT

 +43                       SET PSSFDA(PSSFILE,PSSIEN_",",90)="@"

 +44                       DO FILE^DIE("","PSSFDA","PSSERR")

                       End DoDot:2

                       QUIT

               End DoDot:1

 +45       QUIT

 +46      ;

FILE      ; File to be updated

 +1       ;;50.606

 +2        QUIT

PSSNDSU.m