Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXMCLINK

PXMCLINK.m

Go to the documentation of this file.
  1. PXMCLINK ;SLC/PKR - Mapped codes linking and unlinking routines. ;02/20/2019
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
  1. ;
  1. ;==========================================
  1. ASSOVFILE(FILENUM) ;Given a PCE data type file number return the associated
  1. ;V file number.
  1. Q $S(FILENUM=9999999.09:9000010.16,FILENUM=9999999.15:9000010.13,FILENUM=9999999.64:9000010.23,1:"")
  1. ;
  1. ;==========================================
  1. CSCLIST(GBL,IEN,CODESYSL) ;Populate the coding system code list.
  1. N CODE,COESYS,IND,TEMP
  1. K CODESYSL
  1. S IND=0
  1. F S IND=+$O(@GBL@(IEN,210,IND)) Q:IND=0 D
  1. . S TEMP=@GBL@(IEN,210,IND,0)
  1. .;Skip if there already is a Date Linked.
  1. . I $P(TEMP,U,4)'="" Q
  1. . S CODESYS=$P(TEMP,U,1),CODE=$P(TEMP,U,2)
  1. . I CODE'="" S CODESYSL(CODESYS,CODE)=IND
  1. Q
  1. ;
  1. ;==========================================
  1. DELCHK(CODESYSL) ;When there are mappings that are being deleted,
  1. ;if they are also on the list to link remove them from the list to
  1. ;link.
  1. N CODE,CODESYS,DA,GBL,IENS,TEMP,UNLINK
  1. M UNLINK=^TMP($J,"UNLINK")
  1. S GBL=$$GET1^DID(FILENUM,"","","GLOBAL NAME")
  1. S GBL=$P(GBL,"(",1)
  1. S IENS=""
  1. F S IENS=$O(UNLINK(FILENUM,IENS)) Q:IENS="" D
  1. . D DA^DILF(IENS,.DA)
  1. . S TEMP=@GBL@(DA(1),210,DA,0)
  1. . S CODESYS=$P(TEMP,U,1)
  1. . S CODE=$P(TEMP,U,2)
  1. . K CODESYSL(CODESYS,CODE)
  1. Q
  1. ;
  1. ;==========================================
  1. DELMC(FILENUM,CODESYS,CODE,IENS) ;Delete a mapped code.
  1. ;Before deletion save the mapped code in the Deleted Code Mappings
  1. ;multiple.
  1. N ADDIENS,CMSFN,DCMSFN,FDA,KFDA,IEN,MSG,SUBJECT
  1. S IEN=$P(IENS,",",2)
  1. S ADDIENS="+1,"_IEN_","
  1. S DCMSFN=+$$GET1^DID(FILENUM,"DELETED CODE MAPPINGS","","SPECIFIER")
  1. S FDA(DCMSFN,ADDIENS,.01)=CODESYS
  1. S FDA(DCMSFN,ADDIENS,1)=CODE
  1. S FDA(DCMSFN,ADDIENS,2)=$$NOW^XLFDT
  1. S FDA(DCMSFN,ADDIENS,3)=DUZ
  1. D UPDATE^DIE("","FDA","","MSG")
  1. I $D(DIERR) D Q
  1. . N TEXT
  1. . S TEXT(1)="IENS="_IENS
  1. . S TEXT(2)="CODESYS="_CODESYS_", CODE="_CODE
  1. . S SUBJECT="Mapped code copy before deletion failed for file #"_FILENUM
  1. . D SENDEMSG(SUBJECT,.MSG,.TEXT)
  1. S CMSFN=+$$GET1^DID(FILENUM,"CODE MAPPINGS","","SPECIFIER")
  1. S KFDA(CMSFN,IENS,.01)="@"
  1. D FILE^DIE("","KFDA","MSG")
  1. I $D(DIERR) D Q
  1. . N TEXT
  1. . S TEXT(1)="IENS="_IENS
  1. . S TEXT(2)="CODESYS="_CODESYS_", CODE="_CODE
  1. . S SUBJECT="Mapped code deletion failed for file #"_FILENUM
  1. . D SENDEMSG(SUBJECT,.MSG,.TEXT)
  1. Q
  1. ;
  1. ;==========================================
  1. ;legacy data that has been mapped to standard codes and link them
  1. ;through the Mapped Source field.
  1. ;FILENUM is the file number of the data type file.
  1. ;GBL is the corresponding global
  1. ;IEN is the internal entry number of the data type.
  1. ;CODESYSL is the list of mapped codes: (CODESYS,CODE)
  1. N ASSOVFILE,CODE,CODEDT,CODEIEN,CODESYS,DAS,DATE,DFN,ERROR,FDA,FDAIEN
  1. N FROM,IENS,IND,MSG,MSOURCE,NUMLINK,NL,SUBJECT,TO
  1. N VCODFNUM,VFDATA,VISITIEN
  1. K ^TMP("PXXMZ",$J)
  1. S ASSOVFILE=$$ASSOVFILE(FILENUM)
  1. I '$D(^PXRMINDX(ASSOVFILE,"IP",IEN)) Q
  1. S MSOURCE=FILENUM_";"_IEN
  1. S IENS="+1,"
  1. S CODESYS="",NL=2
  1. S VCODFNUM=9000010.71
  1. F S CODESYS=$O(CODESYSL(CODESYS)) Q:CODESYS="" D
  1. . K FDA
  1. . S FDA(VCODFNUM,IENS,300)=MSOURCE
  1. . S FDA(VCODFNUM,IENS,.05)=CODESYS
  1. . S CODE=""
  1. . F S CODE=$O(CODESYSL(CODESYS,CODE)) Q:CODE="" D
  1. .. S NUMLINK(CODESYS,CODE)=0
  1. .. S FDA(VCODFNUM,IENS,.01)=CODE
  1. .. S DFN=""
  1. .. F S DFN=$O(^PXRMINDX(ASSOVFILE,"IP",IEN,DFN)) Q:DFN="" D
  1. ... S ERROR=0
  1. ... S FDA(VCODFNUM,IENS,.02)=DFN
  1. ... S DATE=""
  1. ... F S DATE=$O(^PXRMINDX(ASSOVFILE,"IP",IEN,DFN,DATE)) Q:DATE="" D
  1. .... S DAS=""
  1. .... F S DAS=$O(^PXRMINDX(ASSOVFILE,"IP",IEN,DFN,DATE,DAS)) Q:DAS="" D
  1. ..... D VFDATA(VCODFNUM,ASSOVFILE,DAS,IENS,.FDA)
  1. .....;If the code is a duplicate do not add it.
  1. ..... S VISITIEN=FDA(VCODFNUM,IENS,.03)
  1. ..... S CODEDT=FDA(VCODFNUM,IENS,1201)
  1. ..... I CODEDT="" S CODEDT=$P(^AUPNVSIT(VISITIEN,0),U,1)
  1. ..... I $$VSCDUP^PXKMCODE(CODESYS,CODE,VISITIEN,CODEDT,MSOURCE) Q
  1. ..... K FDAIEN,MSG
  1. ..... D UPDATE^DIE("S","FDA","FDAIEN","MSG")
  1. ..... I $D(DIERR) D Q
  1. ...... S ERROR=1
  1. ...... S SUBJECT="Mapped code linking failed for file #"_FILENUM_", IEN="_IEN_", DFN="_DFN
  1. ...... D SENDEMSG(SUBJECT,.MSG)
  1. ..... S NUMLINK(CODESYS,CODE)=NUMLINK(CODESYS,CODE)+1
  1. .....;Fire PXK VISIT DATA EVENT for the addition of a code.
  1. ..... D ADDEVENT^PXMCEVNT(VCODFNUM,FDAIEN(1))
  1. I ERROR K ^TMP("PXXMZ",$J) Q
  1. N ENAME,GNAME,LINKDT
  1. D SETTF(.TO,.FROM)
  1. S GNAME=$$GET1^DID(FILENUM,"","","NAME")
  1. S ENAME=$P($G(@GBL@(IEN,0)),U,1)
  1. S SUBJECT=GNAME_" entry "_ENAME_" has been linked."
  1. S LINKDT=$$NOW^XLFDT
  1. S ^TMP("PXXMZ",$J,1,0)="Linking completed at "_$$FMTE^XLFDT(LINKDT,"5Z")
  1. S ^TMP("PXXMZ",$J,2,0)="The following codes were linked:"
  1. S CODESYS=""
  1. F S CODESYS=$O(CODESYSL(CODESYS)) Q:CODESYS="" D
  1. . S CODE=""
  1. . F S CODE=$O(CODESYSL(CODESYS,CODE)) Q:CODE="" D
  1. ..;Set the Date Linked.
  1. .. S IND=CODESYSL(CODESYS,CODE)
  1. .. S $P(@GBL@(IEN,210,IND,0),U,4)=LINKDT
  1. .. S NL=NL+1,^TMP("PXXMZ",$J,NL,0)=" "_CODESYS_": "_CODE
  1. .. I NUMLINK(CODESYS,CODE)>0 D
  1. ... S NL=NL+1,^TMP("PXXMZ",$J,NL,0)=" There were "_NUMLINK(CODESYS,CODE)_" instances where the code was linked."
  1. .. S NL=NL+1,^TMP("PXXMZ",$J,NL,0)=""
  1. D SEND^PXMSG("PXXMZ",SUBJECT,.TO,FROM)
  1. K ^TMP("PXXMZ",$J)
  1. Q
  1. ;
  1. ;==========================================
  1. LINKALL ;Link all national exams, education topics, and health factors
  1. ;that have been mapped.
  1. N CLASS,IEN,FILENUM,GBL,GNAME,NL,NMAPPED,TEXT
  1. K ^TMP("PXXMZ",$J)
  1. S NL=1
  1. F FILENUM=9999999.09,9999999.15,9999999.64 D
  1. . S GBL=$$GET1^DID(FILENUM,"","","GLOBAL NAME")
  1. . S GBL=$P(GBL,"(",1)
  1. . S GNAME=$$GET1^DID(FILENUM,"","","NAME")
  1. . S NL=NL+1,^TMP("PXXMZ",$J,NL,0)=""
  1. . S NL=NL+1,^TMP("PXXMZ",$J,NL,0)="Linking national "_GNAME_" that have been mapped."
  1. . S IEN=0
  1. . F S IEN=+$O(@GBL@(IEN)) Q:IEN=0 D
  1. .. S NMAPPED=+$P($G(@GBL@(IEN,210,0)),U,4)
  1. .. I NMAPPED=0 Q
  1. .. S CLASS=$P(@GBL@(IEN,100),U,1)
  1. .. I CLASS'="N" Q
  1. .. S NL=NL+1,^TMP("PXXMZ",$J,NL,0)=" Linking "_GNAME_": "_$P(@GBL@(IEN,0),U,1)
  1. .. D CSCLIST^PXMCLINK(GBL,IEN,.CODESYSL)
  1. .. I '$D(CODESYSL) Q
  1. .. D LINK^PXMCLINK(FILENUM,GBL,IEN,CODESYSL,0)
  1. D SEND^PXMSG("PXXMZ","LINKING NATIONAL PCE ENTRIES",DUZ,"PCE")
  1. K ^TMP("PXXMZ",$J)
  1. Q
  1. ;
  1. ;==========================================
  1. ;called from ScreenMan form post-save.
  1. ;It there are any, ask the user if they want to link them.
  1. N CODE,CODESYS,CODESYSL,DDS,DIR,DIR0,ENAME,GBL,GNAME,NL,NMAPPED
  1. N STARTDT,TEMP,TEXT,VFILENUM,X,Y
  1. S GBL=$$GET1^DID(FILENUM,"","","GLOBAL NAME")
  1. S GBL=$P(GBL,"(",1)
  1. S NMAPPED=+$P($G(@GBL@(IEN,210,0)),U,4)
  1. I NMAPPED=0 Q
  1. S GNAME=$$GET1^DID(FILENUM,"","","NAME")
  1. S ENAME=$P($G(@GBL@(IEN,0)),U,1)
  1. D CSCLIST^PXMCLINK(GBL,IEN,.CODESYSL)
  1. I $D(^TMP($J,"UNLINK",FILENUM)) D DELCHK(.CODESYSL)
  1. I '$D(CODESYSL) Q
  1. S TEXT(1)="The following codes have been mapped but not linked to existing"
  1. S TEXT(2)=ENAME_" "_GNAME_" patient data:"
  1. S CODESYS="",NL=2
  1. F S CODESYS=$O(CODESYSL(CODESYS)) Q:CODESYS="" D
  1. . S CODE=""
  1. . F S CODE=$O(CODESYSL(CODESYS,CODE)) Q:CODE="" D
  1. .. S NL=NL+1,TEXT(NL)=" "_CODESYS_" "_CODE
  1. S NL=NL+1,TEXT(NL)=""
  1. D EN^DDIOL(.TEXT)
  1. S VFILENUM=$$ASSOVFILE(FILENUM)
  1. I '$D(^PXRMINDX(VFILENUM,"IP",IEN)) D Q
  1. . K TEXT
  1. . S TEXT(1)=""
  1. . S TEXT(2)="No patients have been given the "_GNAME_": "_ENAME
  1. . S TEXT(3)="there is no data to link."
  1. . D EN^DDIOL(.TEXT) H 3
  1. K DIR
  1. S DIR(0)="YAO",DIR("B")="N"
  1. S DIR("A")="Do you want to link them? "
  1. D ^DIR
  1. I 'Y Q
  1. K DIR
  1. S DIR(0)="DAO^NOW::ERX"
  1. S DIR("A")="When do you want the linking job to start? "
  1. S DIR("B")="NOW"
  1. D ^DIR
  1. I (Y="^")!(Y="") Q
  1. S STARTDT=Y
  1. D TASKLINK(FILENUM,GBL,IEN,.CODESYSL,STARTDT)
  1. Q
  1. ;
  1. ;==========================================
  1. ;ScreenMan form post-save.
  1. ;FILENUM is the file number of the data type file.
  1. ;IEN is the internal entry number of the data type.
  1. N DA,DDS,DIR,DIR0,GBL,IENS,STARTDT,NL,TEMP,TEXT,X,Y,UNLINK
  1. I '$D(^TMP($J,"UNLINK")) Q
  1. M UNLINK=^TMP($J,"UNLINK")
  1. K ^TMP($J,"UNLINK")
  1. S GBL=$$GET1^DID(FILENUM,"","","GLOBAL NAME")
  1. S GBL=$P(GBL,"(",1)
  1. S TEXT(1)="The following codes have been selected for deletion and unlinking:"
  1. S IENS="",NL=1
  1. F S IENS=$O(UNLINK(FILENUM,IENS)) Q:IENS="" D
  1. . D DA^DILF(IENS,.DA)
  1. . S TEMP=@GBL@(DA(1),210,DA,0)
  1. . S CODESYS=$P(TEMP,U,1)
  1. . S CODE=$P(TEMP,U,2)
  1. . S NL=NL+1,TEXT(NL)=" "_CODESYS_" "_CODE
  1. . D DELMC(FILENUM,CODESYS,CODE,IENS)
  1. S NL=NL+1,TEXT(NL)=""
  1. S NL=NL+1,TEXT(NL)="This process will also check all the deleted code mappings for this entry"
  1. S NL=NL+1,TEXT(NL)="to make sure they are completely unlinked."
  1. D EN^DDIOL(.TEXT)
  1. S STARTDT=$$NOW^XLFDT
  1. D TASKUNLK(FILENUM,IEN,STARTDT)
  1. Q
  1. ;
  1. ;==========================================
  1. SENDEMSG(SUBJECT,FMMSG,ADDTEXT) ;
  1. N IND,EMSG,FROM,NL,TO
  1. ;A FileMan error has occurred and we are sending an error message, so
  1. ;cleanup the FileMan error variables.
  1. D CLEAN^DILF
  1. D SETTF(.TO,.FROM)
  1. K ^TMP("PXEMSG",$J)
  1. S NL=1,^TMP("PXEMSG",$J,NL,0)=SUBJECT
  1. I $D(ADDTEXT) D
  1. . S IND=0
  1. . F S IND=$O(ADDTEXT(IND)) Q:IND="" D
  1. .. S NL=NL+1,^TMP("PXEMSG",$J,NL,0)=ADDTEXT(IND)
  1. S NL=NL+1,^TMP("PXEMSG",$J,NL,0)="The following error message was returned by FileMan:"
  1. D ACOPY^PXUTIL("FMMSG","EMSG()")
  1. S IND=0 F S IND=$O(EMSG(IND)) Q:IND="" S NL=NL+1,^TMP("PXEMSG",$J,NL,0)=EMSG(IND)
  1. D SEND^PXMSG("PXEMSG",SUBJECT,.TO,FROM)
  1. K ^TMP("PXEMSG",$J)
  1. Q
  1. ;
  1. ;==========================================
  1. SETTF(TO,FROM) ;Set the TO and FROM for delivering the MailMan messages.
  1. N MGIEN,MGROUP
  1. S FROM=$$GET1^DIQ(200,DUZ,.01)
  1. S MGIEN=$P($G(^PX(815,1,650)),U,1)
  1. S TO(DUZ)=""
  1. I MGIEN'="" D
  1. . S MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
  1. . S TO(MGROUP)=""
  1. Q
  1. ;
  1. ;==========================================
  1. ;mapped codes.
  1. N ZTREQ,ZTSAVE,ZTSK,ZTIO,ZTDTH,ZTRTN
  1. S ZTREQ="@"
  1. S ZTSAVE("FILENUM")=""
  1. S ZTSAVE("GBL")=""
  1. S ZTSAVE("IEN")=""
  1. S ZTSAVE("CODESYSL(")=""
  1. S ZTRTN="TSKLINK^PXMCLINK"
  1. S ZTDESC="Link mapped codes for "_GBL_" IEN="_IEN
  1. S ZTDTH=STARTDT
  1. S ZTIO=""
  1. D ^%ZTLOAD
  1. I ZTSK'="" W !,"Task number ",ZTSK," queued." H 3
  1. Q
  1. ;
  1. ;==========================================
  1. TASKUNLK(FILENUM,IEN,STARTDT) ;Start a task to unlink mapped codes.
  1. N ZTREQ,ZTSAVE,ZTSK,ZTIO,ZTDTH,ZTRTN
  1. S ZTREQ="@"
  1. S ZTSAVE("IEN")=""
  1. S ZTSAVE("FILENUM")=""
  1. S ZTRTN="TSKUNLK^PXMCLINK"
  1. S ZTDESC="Unlink mapped codes for "_GBL_" IEN="_IEN
  1. S ZTDTH=STARTDT
  1. S ZTIO=""
  1. D ^%ZTLOAD
  1. I ZTSK'="" W !,"Task number ",ZTSK," queued." H 3
  1. Q
  1. ;
  1. ;==========================================
  1. D LINK^PXMCLINK(FILENUM,GBL,IEN,.CODESYSL)
  1. Q
  1. ;
  1. ;==========================================
  1. TSKUNLK ;Arguments come through ZTSAVE.
  1. D UNLINK^PXMCLINK(FILENUM,IEN)
  1. Q
  1. ;
  1. ;==========================================
  1. ;FILENUM is the file number of the data type file.
  1. ;IEN is the internal entry number of the data type.
  1. ;UNLINK is the list of V-file entries to delete.
  1. N ASSOVFILE,CODE,CODEIEN,CODESYS,DA,ENAME,ERROR,FROM,GBL,GNAME,IENS
  1. N IND,KFDA,MSG,NL,NUMUNL,SCC,SOURCE,SUBJECT,TEMP,TO,UNLINKDT
  1. N VCODFNUM,VSCIEN,ZNODE
  1. S ASSOVFILE=$$ASSOVFILE(FILENUM)
  1. S SOURCE=FILENUM_";"_IEN
  1. S GBL=$$GET1^DID(FILENUM,"","","GLOBAL NAME")
  1. S GBL=$P(GBL,"(",1)
  1. S GNAME=$$GET1^DID(FILENUM,"","","NAME")
  1. S ENAME=$P($G(@GBL@(IEN,0)),U,1)
  1. S SUBJECT="Code mapping(s) for "_GNAME_" entry "_ENAME_" have been deleted and unlinked."
  1. K ^TMP("PXXMZ",$J)
  1. S ^TMP("PXXMZ",$J,1,0)=SUBJECT
  1. S ^TMP("PXXMZ",$J,2,0)="The following codes were deleted and unlinked:"
  1. S (ERROR,IND)=0,NL=2,VCODFNUM=9000010.71
  1. F S IND=+$O(@GBL@(IEN,230,IND)) Q:IND=0 D
  1. . S TEMP=@GBL@(IEN,230,IND,0)
  1. .;If there is a MSE Removal Date this entry is already done.
  1. . I $P(TEMP,U,5)'="" Q
  1. . S CODESYS=$P(TEMP,U,1)
  1. . S CODE=$P(TEMP,U,2)
  1. . S ERROR=0
  1. . S NUMUNL=0
  1. . S NL=NL+1,^TMP("PXXMZ",$J,NL,0)=" "_CODESYS_" "_CODE
  1. . S UNLINKDT=$$NOW^XLFDT
  1. . K SCC
  1. . M SCC=^AUPNVSC("SCC",SOURCE,CODESYS,CODE)
  1. . S VSCIEN=""
  1. . F S VSCIEN=$O(SCC(VSCIEN)) Q:VSCIEN="" D
  1. .. S ZNODE=^AUPNVSC(VSCIEN,0)
  1. .. K KFDA,MSG
  1. .. S KFDA(VCODFNUM,VSCIEN_",",.01)="@"
  1. .. D FILE^DIE("","KFDA","MSG")
  1. .. I '$D(DIERR) S NUMUNL=NUMUNL+1 D DELEVENT^PXMCEVNT(VCODFNUM,VSCIEN,ZNODE)
  1. .. I $D(DIERR) D
  1. ... S ERROR=1
  1. ... S SUBJECT="Mapped code unlinking failed for file #"_FILENUM_", IEN="_IEN_", VSCIEN="_VSCIEN
  1. ... D SENDEMSG(SUBJECT,.MSG)
  1. . I 'ERROR D
  1. .. S $P(@GBL@(IEN,230,IND,0),U,5)=UNLINKDT
  1. .. S NL=NL+1,^TMP("PXXMZ",$J,NL,0)=" "_NUMUNL_" V Standard Codes entries were removed."
  1. .. S NL=NL+1,^TMP("PXXMZ",$J,NL,0)=""
  1. I 'ERROR D
  1. . D SETTF(.TO,.FROM)
  1. . D SEND^PXMSG("PXXMZ",SUBJECT,.TO,"PCE MANAGEMENT")
  1. K ^TMP($J,"LIST"),^TMP("PXXMZ",$J)
  1. Q
  1. ;
  1. ;==========================================
  1. VFDATA(VCODFNUM,ASSOVFILE,IEN,IENS,FDA) ;Load the additional V-file data into
  1. ;the FDA.
  1. S FDA(VCODFNUM,IENS,.03)=$$GET1^DIQ(ASSOVFILE,IEN,.03,"I")
  1. S FDA(VCODFNUM,IENS,1201)=$$GET1^DIQ(ASSOVFILE,IEN,1201,"I")
  1. S FDA(VCODFNUM,IENS,1202)=$$GET1^DIQ(ASSOVFILE,IEN,1202,"I")
  1. S FDA(VCODFNUM,IENS,1204)=$$GET1^DIQ(ASSOVFILE,IEN,1204,"I")
  1. S FDA(VCODFNUM,IENS,81202)=$$GET1^DIQ(ASSOVFILE,IEN,81202,"I")
  1. S FDA(VCODFNUM,IENS,81203)=$$GET1^DIQ(ASSOVFILE,IEN,81203,"I")
  1. Q
  1. ;