PSSNDSU ;DAL/JCH - MEDS DOSAGE FORM NDS UTILITIES ;09/07/2017
;;1.0;PHARMACY DATA MANAGEMENT;**211**;9/30/97;Build 20
;
Q
;
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
Q
;
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)
Q
;
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)
Q
;
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)
Q
;
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)
Q
;
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")
Q
;
FILE ; File to be updated
;;50.606
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSNDSU 5881 printed Dec 13, 2024@02:33:14 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
