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

PXKMCODE.m

Go to the documentation of this file.
  1. PXKMCODE ;SLC/PKR Store mapped codes in the appropriate file ;11/22/2019
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
  1. ;================================
  1. EN ;General entry point.
  1. ; VARIABLES
  1. ; PXKAFT = The AFTER variables created in PXKMAIN
  1. ; PXKBEF = The BEFORE variables created in PXKMAIN
  1. ; PXKFG(ED,DE,AD) =The EDIT,DELETE,ADD flags
  1. N ACTION
  1. S ACTION=$S(PXKFGAD=1:"ADD",PXKFGED=1:"EDIT",PXKFGDE=1:"DEL",1:"")
  1. I (ACTION="EDIT")!(ACTION="") Q
  1. I PXKCAT="HF" D HF(ACTION) Q
  1. I PXKCAT="PED" D PED(ACTION) Q
  1. I PXKCAT="XAM" D XAM(ACTION)
  1. Q
  1. ;
  1. ;================================
  1. ERRORD2P(NODE,SUBJECT,MSG) ;Set the DATA2PCE error flag and populate
  1. ;the error arrays.
  1. S PXAERRF=-1
  1. S PXAPROB($J,PXASUB,"ERROR",NODE)=SUBJECT
  1. M PXKERROR(NODE)=MSG
  1. Q
  1. ;
  1. ;================================
  1. ERRORLM(SUBJECT,MSG) ;Error display if error occurred while in List Manager.
  1. W !,SUBJECT
  1. D AWRITE^PXUTIL("MSG")
  1. H 3
  1. Q
  1. ;
  1. ;================================
  1. HF(ACTION) ;
  1. N CODE,CODEDT,CODESYS,HFIEN,IND,TEMP,VFDATA,ZNODE
  1. S ZNODE=$S(ACTION="ADD":PXKAFT(0),1:PXKBEF(0))
  1. S HFIEN=$P(ZNODE,U,1)
  1. S VFDATA("DFN")=$P(ZNODE,U,2)
  1. S VFDATA("VISIT")=$P(ZNODE,U,3)
  1. S VFDATA("MAPPED SOURCE")="9999999.64;"_HFIEN
  1. I ACTION="ADD" D
  1. . S VFDATA("EVENT DATE AND TIME")=$P(PXKAFT(12),U,1)
  1. . S VFDATA("PACKAGE")=$P(PXKAFT(812),U,2)
  1. . S VFDATA("DATA SOURCE")=$P(PXKAFT(812),U,3)
  1. . S CODEDT=VFDATA("EVENT DATE AND TIME")
  1. . I (CODEDT="")!(CODEDT="@") S CODEDT=$P(^AUPNVSIT(VFDATA("VISIT"),0),U,1)
  1. ;Process the list of mapped codes.
  1. S IND=0
  1. F S IND=+$O(^AUTTHF(HFIEN,210,IND)) Q:IND=0 D
  1. . S TEMP=^AUTTHF(HFIEN,210,IND,0)
  1. . S CODESYS=$P(TEMP,U,1),CODE=$P(TEMP,U,2)
  1. .;If the code is inactive do not add it.
  1. . I (ACTION="ADD"),('$$ISCACT^PXLEX(CODESYS,CODE,CODEDT)) Q
  1. . D VSC(ACTION,CODESYS,CODE,.VFDATA)
  1. Q
  1. ;
  1. ;================================
  1. PED(ACTION) ;
  1. N CODE,CODEDT,CODESYS,EDUIEN,IND,TEMP,VFDATA,ZNODE
  1. S ZNODE=$S(ACTION="ADD":PXKAFT(0),1:PXKBEF(0))
  1. S EDUIEN=$P(ZNODE,U,1)
  1. S VFDATA("DFN")=$P(ZNODE,U,2)
  1. S VFDATA("VISIT")=$P(ZNODE,U,3)
  1. S VFDATA("MAPPED SOURCE")="9999999.09;"_EDUIEN
  1. I ACTION="ADD" D
  1. . S VFDATA("EVENT DATE AND TIME")=$P(PXKAFT(12),U,1)
  1. . S VFDATA("PACKAGE")=$P(PXKAFT(812),U,2)
  1. . S VFDATA("DATA SOURCE")=$P(PXKAFT(812),U,3)
  1. . S CODEDT=VFDATA("EVENT DATE AND TIME")
  1. . I (CODEDT="")!(CODEDT="@") S CODEDT=$P(^AUPNVSIT(VFDATA("VISIT"),0),U,1)
  1. ;Process the list of mapped codes.
  1. S IND=0
  1. F S IND=+$O(^AUTTEDT(EDUIEN,210,IND)) Q:IND=0 D
  1. . S TEMP=^AUTTEDT(EDUIEN,210,IND,0)
  1. . S CODESYS=$P(TEMP,U,1),CODE=$P(TEMP,U,2)
  1. .;If the code is inactive do not add it.
  1. . I (ACTION="ADD"),('$$ISCACT^PXLEX(CODESYS,CODE,CODEDT)) Q
  1. . D VSC(ACTION,CODESYS,CODE,.VFDATA)
  1. Q
  1. ;
  1. ;================================
  1. VSC(ACTION,CODESYS,CODE,VFDATA) ;Add or delete a mapped Standard code.
  1. N AFTER,BEFORE,CODEDT,FDA,FDAIEN,MSG
  1. ;Delete.
  1. I ACTION="DEL" D Q
  1. . N IEN
  1. . S IEN=""
  1. . F S IEN=+$O(^AUPNVSC("AD",VFDATA("VISIT"),IEN)) Q:IEN=0 D
  1. ..;Do not delete unless the code and mapped source match.
  1. .. I $P(^AUPNVSC(IEN,0),U,1)'=CODE Q
  1. .. I VFDATA("MAPPED SOURCE")'=$P($G(^AUPNVSC(IEN,300)),U,1) Q
  1. ..;If BEFORE is null and AFTER is not then the entry is being deleted
  1. ..;is being deleted so delete ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC").
  1. .. S AFTER=$G(^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",IEN,0,"AFTER"))
  1. .. S BEFORE=$G(^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",IEN,0,"BEFORE"))
  1. .. I (AFTER'=""),(BEFORE="") K ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",IEN)
  1. .. E D
  1. ... S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",IEN,0,"AFTER")=""
  1. ... S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",IEN,0,"BEFORE")=^AUPNVSC(IEN,0)
  1. .. S FDA(9000010.71,IEN_",",.01)="@"
  1. .. D FILE^DIE("","FDA","MSG")
  1. ..;If the deletion failed send an error message and remove the event
  1. ..;point ^TMP("PXKCO") nodes.
  1. .. I $D(MSG) D Q
  1. ... N SUBJECT
  1. ... S SUBJECT="V STANDARD CODES mapped code deletion failed for file #"_$P(VFDATA("MAPPED SOURCE"),";",1)_", IEN="_$P(VFDATA("MAPPED SOURCE"),";",2)
  1. ... D SENDEMSG^PXMCLINK(SUBJECT,.MSG)
  1. ...;If this is being called from List Manager display the error on
  1. ...;the screen.
  1. ... I $D(VALMCC) D ERRORLM(SUBJECT,.MSG)
  1. ...;If this is being called from DATA2PCE return the error arrays.
  1. ... I '$D(VALMCC) D ERRORD2P("V STANDARD CODES",SUBJECT,.MSG)
  1. ... K ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",IEN,0,"AFTER")
  1. ... K ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",IEN,0,"BEFORE")
  1. ;
  1. ;Add.
  1. I ACTION'="ADD" Q
  1. ;If it is an exact duplicate do not add it.
  1. S CODEDT=VFDATA("EVENT DATE AND TIME")
  1. I CODEDT="" S CODEDT=$P(^AUPNVSIT(VFDATA("VISIT"),0),U,1)
  1. I $$VSCDUP(CODESYS,CODE,VFDATA("VISIT"),CODEDT,VFDATA("MAPPED SOURCE")) Q
  1. S FDA(9000010.71,"+1,",.01)=CODE
  1. S FDA(9000010.71,"+1,",.02)=VFDATA("DFN")
  1. S FDA(9000010.71,"+1,",.03)=VFDATA("VISIT")
  1. S FDA(9000010.71,"+1,",.05)=CODESYS
  1. S FDA(9000010.71,"+1,",300)=VFDATA("MAPPED SOURCE")
  1. S FDA(9000010.71,"+1,",1201)=VFDATA("EVENT DATE AND TIME")
  1. S FDA(9000010.71,"+1,",81202)=VFDATA("PACKAGE")
  1. S FDA(9000010.71,"+1,",81203)=VFDATA("DATA SOURCE")
  1. D UPDATE^DIE("S","FDA","FDAIEN","MSG")
  1. I $D(MSG) D Q
  1. . N SUBJECT
  1. . S SUBJECT="V STANDARD CODES mapped code filing failed for file #"_$P(VFDATA("MAPPED SOURCE"),";",1)_", IEN="_$P(VFDATA("MAPPED SOURCE"),";",2)
  1. . D SENDEMSG^PXMCLINK(SUBJECT,.MSG)
  1. . I $D(VALMCC) D ERRORLM(SUBJECT,.MSG)
  1. . I '$D(VALMCC) D ERRORD2P("V STANDARD CODES",SUBJECT,.MSG)
  1. S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",FDAIEN(1),0,"AFTER")=^AUPNVSC(FDAIEN(1),0)
  1. S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",FDAIEN(1),12,"AFTER")=$G(^AUPNVSC(FDAIEN(1),12))
  1. S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",FDAIEN(1),300,"AFTER")=$G(^AUPNVSC(FDAIEN(1),300))
  1. S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",FDAIEN(1),811,"AFTER")=$G(^AUPNVSC(FDAIEN(1),811))
  1. S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",FDAIEN(1),812,"AFTER")=$G(^AUPNVSC(FDAIEN(1),812))
  1. S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",FDAIEN(1),0,"BEFORE")=""
  1. S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",FDAIEN(1),12,"BEFORE")=""
  1. S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",FDAIEN(1),300,"BEFORE")=""
  1. S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",FDAIEN(1),811,"BEFORE")=""
  1. S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",FDAIEN(1),812,"BEFORE")=""
  1. Q
  1. ;
  1. ;================================
  1. VSCDUP(CODESYS,CODE,VISITIEN,CODEDT,MSOURCE) ;Determine if the standard code is
  1. ; already on the encounter.
  1. N DUP,EVENTDT,MSRC,TEMP,VSCIEN
  1. S (DUP,VSCIEN)=0
  1. F Q:DUP S VSCIEN=+$O(^AUPNVSC("AD",VISITIEN,VSCIEN)) Q:VSCIEN=0 D
  1. . S TEMP=^AUPNVSC(VSCIEN,0)
  1. . S CSYS=$P(TEMP,U,1)
  1. . I $P(TEMP,U,5)'=CODESYS Q
  1. . I $P(TEMP,U,1)'=CODE Q
  1. . S EVENTDT=$P($G(^AUPNVSC(VSCIEN,12)),U,1)
  1. . I EVENTDT="" S EVENTDT=$P(^AUPNVSIT(VISITIEN,0),U,1)
  1. . I EVENTDT'=CODEDT Q
  1. . S MSRC=$P($G(^AUPNVSC(VSCIEN,300)),U,1)
  1. .;If the coding system, code, date, and mapped source match it
  1. .;is a duplicate.
  1. . I MSRC=MSOURCE S DUP=1
  1. Q DUP
  1. ;
  1. ;================================
  1. XAM(ACTION) ;
  1. N CODE,CODEDT,CODESYS,EXAMIEN,IND,TEMP,VFDATA,ZNODE
  1. S ZNODE=$S(ACTION="ADD":PXKAFT(0),1:PXKBEF(0))
  1. S EXAMIEN=$P(ZNODE,U,1)
  1. S VFDATA("DFN")=$P(ZNODE,U,2)
  1. S VFDATA("VISIT")=$P(ZNODE,U,3)
  1. S VFDATA("MAPPED SOURCE")="9999999.15;"_EXAMIEN
  1. I ACTION="ADD" D
  1. . S VFDATA("EVENT DATE AND TIME")=$P(PXKAFT(12),U,1)
  1. . S VFDATA("PACKAGE")=$P(PXKAFT(812),U,2)
  1. . S VFDATA("DATA SOURCE")=$P(PXKAFT(812),U,3)
  1. . S CODEDT=VFDATA("EVENT DATE AND TIME")
  1. . I (CODEDT="")!(CODEDT="@") S CODEDT=$P(^AUPNVSIT(VFDATA("VISIT"),0),U,1)
  1. ;Process the list of mapped codes.
  1. S IND=0
  1. F S IND=+$O(^AUTTEXAM(EXAMIEN,210,IND)) Q:IND=0 D
  1. . S TEMP=^AUTTEXAM(EXAMIEN,210,IND,0)
  1. . S CODESYS=$P(TEMP,U,1),CODE=$P(TEMP,U,2)
  1. .;If the code is inactive do not add it.
  1. . I (ACTION="ADD"),('$$ISCACT^PXLEX(CODESYS,CODE,CODEDT)) Q
  1. . D VSC(ACTION,CODESYS,CODE,.VFDATA)
  1. Q
  1. ;