PXKMCODE ;SLC/PKR Store mapped codes in the appropriate file ;11/22/2019
;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
;================================
EN ;General entry point.
; VARIABLES
; PXKAFT = The AFTER variables created in PXKMAIN
; PXKBEF = The BEFORE variables created in PXKMAIN
; PXKFG(ED,DE,AD) =The EDIT,DELETE,ADD flags
N ACTION
S ACTION=$S(PXKFGAD=1:"ADD",PXKFGED=1:"EDIT",PXKFGDE=1:"DEL",1:"")
I (ACTION="EDIT")!(ACTION="") Q
I PXKCAT="HF" D HF(ACTION) Q
I PXKCAT="PED" D PED(ACTION) Q
I PXKCAT="XAM" D XAM(ACTION)
Q
;
;================================
ERRORD2P(NODE,SUBJECT,MSG) ;Set the DATA2PCE error flag and populate
;the error arrays.
S PXAERRF=-1
S PXAPROB($J,PXASUB,"ERROR",NODE)=SUBJECT
M PXKERROR(NODE)=MSG
Q
;
;================================
ERRORLM(SUBJECT,MSG) ;Error display if error occurred while in List Manager.
W !,SUBJECT
D AWRITE^PXUTIL("MSG")
H 3
Q
;
;================================
HF(ACTION) ;
N CODE,CODEDT,CODESYS,HFIEN,IND,TEMP,VFDATA,ZNODE
S ZNODE=$S(ACTION="ADD":PXKAFT(0),1:PXKBEF(0))
S HFIEN=$P(ZNODE,U,1)
S VFDATA("DFN")=$P(ZNODE,U,2)
S VFDATA("VISIT")=$P(ZNODE,U,3)
S VFDATA("MAPPED SOURCE")="9999999.64;"_HFIEN
I ACTION="ADD" D
. S VFDATA("EVENT DATE AND TIME")=$P(PXKAFT(12),U,1)
. S VFDATA("PACKAGE")=$P(PXKAFT(812),U,2)
. S VFDATA("DATA SOURCE")=$P(PXKAFT(812),U,3)
. S CODEDT=VFDATA("EVENT DATE AND TIME")
. I (CODEDT="")!(CODEDT="@") S CODEDT=$P(^AUPNVSIT(VFDATA("VISIT"),0),U,1)
;Process the list of mapped codes.
S IND=0
F S IND=+$O(^AUTTHF(HFIEN,210,IND)) Q:IND=0 D
. S TEMP=^AUTTHF(HFIEN,210,IND,0)
. S CODESYS=$P(TEMP,U,1),CODE=$P(TEMP,U,2)
.;If the code is inactive do not add it.
. I (ACTION="ADD"),('$$ISCACT^PXLEX(CODESYS,CODE,CODEDT)) Q
. D VSC(ACTION,CODESYS,CODE,.VFDATA)
Q
;
;================================
PED(ACTION) ;
N CODE,CODEDT,CODESYS,EDUIEN,IND,TEMP,VFDATA,ZNODE
S ZNODE=$S(ACTION="ADD":PXKAFT(0),1:PXKBEF(0))
S EDUIEN=$P(ZNODE,U,1)
S VFDATA("DFN")=$P(ZNODE,U,2)
S VFDATA("VISIT")=$P(ZNODE,U,3)
S VFDATA("MAPPED SOURCE")="9999999.09;"_EDUIEN
I ACTION="ADD" D
. S VFDATA("EVENT DATE AND TIME")=$P(PXKAFT(12),U,1)
. S VFDATA("PACKAGE")=$P(PXKAFT(812),U,2)
. S VFDATA("DATA SOURCE")=$P(PXKAFT(812),U,3)
. S CODEDT=VFDATA("EVENT DATE AND TIME")
. I (CODEDT="")!(CODEDT="@") S CODEDT=$P(^AUPNVSIT(VFDATA("VISIT"),0),U,1)
;Process the list of mapped codes.
S IND=0
F S IND=+$O(^AUTTEDT(EDUIEN,210,IND)) Q:IND=0 D
. S TEMP=^AUTTEDT(EDUIEN,210,IND,0)
. S CODESYS=$P(TEMP,U,1),CODE=$P(TEMP,U,2)
.;If the code is inactive do not add it.
. I (ACTION="ADD"),('$$ISCACT^PXLEX(CODESYS,CODE,CODEDT)) Q
. D VSC(ACTION,CODESYS,CODE,.VFDATA)
Q
;
;================================
VSC(ACTION,CODESYS,CODE,VFDATA) ;Add or delete a mapped Standard code.
N AFTER,BEFORE,CODEDT,FDA,FDAIEN,MSG
;Delete.
I ACTION="DEL" D Q
. N IEN
. S IEN=""
. F S IEN=+$O(^AUPNVSC("AD",VFDATA("VISIT"),IEN)) Q:IEN=0 D
..;Do not delete unless the code and mapped source match.
.. I $P(^AUPNVSC(IEN,0),U,1)'=CODE Q
.. I VFDATA("MAPPED SOURCE")'=$P($G(^AUPNVSC(IEN,300)),U,1) Q
..;If BEFORE is null and AFTER is not then the entry is being deleted
..;is being deleted so delete ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC").
.. S AFTER=$G(^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",IEN,0,"AFTER"))
.. S BEFORE=$G(^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",IEN,0,"BEFORE"))
.. I (AFTER'=""),(BEFORE="") K ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",IEN)
.. E D
... S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",IEN,0,"AFTER")=""
... S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",IEN,0,"BEFORE")=^AUPNVSC(IEN,0)
.. S FDA(9000010.71,IEN_",",.01)="@"
.. D FILE^DIE("","FDA","MSG")
..;If the deletion failed send an error message and remove the event
..;point ^TMP("PXKCO") nodes.
.. I $D(MSG) D Q
... N SUBJECT
... S SUBJECT="V STANDARD CODES mapped code deletion failed for file #"_$P(VFDATA("MAPPED SOURCE"),";",1)_", IEN="_$P(VFDATA("MAPPED SOURCE"),";",2)
... D SENDEMSG^PXMCLINK(SUBJECT,.MSG)
...;If this is being called from List Manager display the error on
...;the screen.
... I $D(VALMCC) D ERRORLM(SUBJECT,.MSG)
...;If this is being called from DATA2PCE return the error arrays.
... I '$D(VALMCC) D ERRORD2P("V STANDARD CODES",SUBJECT,.MSG)
... K ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",IEN,0,"AFTER")
... K ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",IEN,0,"BEFORE")
;
;Add.
I ACTION'="ADD" Q
;If it is an exact duplicate do not add it.
S CODEDT=VFDATA("EVENT DATE AND TIME")
I CODEDT="" S CODEDT=$P(^AUPNVSIT(VFDATA("VISIT"),0),U,1)
I $$VSCDUP(CODESYS,CODE,VFDATA("VISIT"),CODEDT,VFDATA("MAPPED SOURCE")) Q
S FDA(9000010.71,"+1,",.01)=CODE
S FDA(9000010.71,"+1,",.02)=VFDATA("DFN")
S FDA(9000010.71,"+1,",.03)=VFDATA("VISIT")
S FDA(9000010.71,"+1,",.05)=CODESYS
S FDA(9000010.71,"+1,",300)=VFDATA("MAPPED SOURCE")
S FDA(9000010.71,"+1,",1201)=VFDATA("EVENT DATE AND TIME")
S FDA(9000010.71,"+1,",81202)=VFDATA("PACKAGE")
S FDA(9000010.71,"+1,",81203)=VFDATA("DATA SOURCE")
D UPDATE^DIE("S","FDA","FDAIEN","MSG")
I $D(MSG) D Q
. N SUBJECT
. S SUBJECT="V STANDARD CODES mapped code filing failed for file #"_$P(VFDATA("MAPPED SOURCE"),";",1)_", IEN="_$P(VFDATA("MAPPED SOURCE"),";",2)
. D SENDEMSG^PXMCLINK(SUBJECT,.MSG)
. I $D(VALMCC) D ERRORLM(SUBJECT,.MSG)
. I '$D(VALMCC) D ERRORD2P("V STANDARD CODES",SUBJECT,.MSG)
S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",FDAIEN(1),0,"AFTER")=^AUPNVSC(FDAIEN(1),0)
S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",FDAIEN(1),12,"AFTER")=$G(^AUPNVSC(FDAIEN(1),12))
S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",FDAIEN(1),300,"AFTER")=$G(^AUPNVSC(FDAIEN(1),300))
S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",FDAIEN(1),811,"AFTER")=$G(^AUPNVSC(FDAIEN(1),811))
S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",FDAIEN(1),812,"AFTER")=$G(^AUPNVSC(FDAIEN(1),812))
S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",FDAIEN(1),0,"BEFORE")=""
S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",FDAIEN(1),12,"BEFORE")=""
S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",FDAIEN(1),300,"BEFORE")=""
S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",FDAIEN(1),811,"BEFORE")=""
S ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC",FDAIEN(1),812,"BEFORE")=""
Q
;
;================================
VSCDUP(CODESYS,CODE,VISITIEN,CODEDT,MSOURCE) ;Determine if the standard code is
; already on the encounter.
N DUP,EVENTDT,MSRC,TEMP,VSCIEN
S (DUP,VSCIEN)=0
F Q:DUP S VSCIEN=+$O(^AUPNVSC("AD",VISITIEN,VSCIEN)) Q:VSCIEN=0 D
. S TEMP=^AUPNVSC(VSCIEN,0)
. S CSYS=$P(TEMP,U,1)
. I $P(TEMP,U,5)'=CODESYS Q
. I $P(TEMP,U,1)'=CODE Q
. S EVENTDT=$P($G(^AUPNVSC(VSCIEN,12)),U,1)
. I EVENTDT="" S EVENTDT=$P(^AUPNVSIT(VISITIEN,0),U,1)
. I EVENTDT'=CODEDT Q
. S MSRC=$P($G(^AUPNVSC(VSCIEN,300)),U,1)
.;If the coding system, code, date, and mapped source match it
.;is a duplicate.
. I MSRC=MSOURCE S DUP=1
Q DUP
;
;================================
XAM(ACTION) ;
N CODE,CODEDT,CODESYS,EXAMIEN,IND,TEMP,VFDATA,ZNODE
S ZNODE=$S(ACTION="ADD":PXKAFT(0),1:PXKBEF(0))
S EXAMIEN=$P(ZNODE,U,1)
S VFDATA("DFN")=$P(ZNODE,U,2)
S VFDATA("VISIT")=$P(ZNODE,U,3)
S VFDATA("MAPPED SOURCE")="9999999.15;"_EXAMIEN
I ACTION="ADD" D
. S VFDATA("EVENT DATE AND TIME")=$P(PXKAFT(12),U,1)
. S VFDATA("PACKAGE")=$P(PXKAFT(812),U,2)
. S VFDATA("DATA SOURCE")=$P(PXKAFT(812),U,3)
. S CODEDT=VFDATA("EVENT DATE AND TIME")
. I (CODEDT="")!(CODEDT="@") S CODEDT=$P(^AUPNVSIT(VFDATA("VISIT"),0),U,1)
;Process the list of mapped codes.
S IND=0
F S IND=+$O(^AUTTEXAM(EXAMIEN,210,IND)) Q:IND=0 D
. S TEMP=^AUTTEXAM(EXAMIEN,210,IND,0)
. S CODESYS=$P(TEMP,U,1),CODE=$P(TEMP,U,2)
.;If the code is inactive do not add it.
. I (ACTION="ADD"),('$$ISCACT^PXLEX(CODESYS,CODE,CODEDT)) Q
. D VSC(ACTION,CODESYS,CODE,.VFDATA)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXKMCODE 7902 printed Sep 23, 2025@20:05:32 Page 2
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
+2 ;================================
EN ;General entry point.
+1 ; VARIABLES
+2 ; PXKAFT = The AFTER variables created in PXKMAIN
+3 ; PXKBEF = The BEFORE variables created in PXKMAIN
+4 ; PXKFG(ED,DE,AD) =The EDIT,DELETE,ADD flags
+5 NEW ACTION
+6 SET ACTION=$SELECT(PXKFGAD=1:"ADD",PXKFGED=1:"EDIT",PXKFGDE=1:"DEL",1:"")
+7 IF (ACTION="EDIT")!(ACTION="")
QUIT
+8 IF PXKCAT="HF"
DO HF(ACTION)
QUIT
+9 IF PXKCAT="PED"
DO PED(ACTION)
QUIT
+10 IF PXKCAT="XAM"
DO XAM(ACTION)
+11 QUIT
+12 ;
+13 ;================================
ERRORD2P(NODE,SUBJECT,MSG) ;Set the DATA2PCE error flag and populate
+1 ;the error arrays.
+2 SET PXAERRF=-1
+3 SET PXAPROB($JOB,PXASUB,"ERROR",NODE)=SUBJECT
+4 MERGE PXKERROR(NODE)=MSG
+5 QUIT
+6 ;
+7 ;================================
ERRORLM(SUBJECT,MSG) ;Error display if error occurred while in List Manager.
+1 WRITE !,SUBJECT
+2 DO AWRITE^PXUTIL("MSG")
+3 HANG 3
+4 QUIT
+5 ;
+6 ;================================
HF(ACTION) ;
+1 NEW CODE,CODEDT,CODESYS,HFIEN,IND,TEMP,VFDATA,ZNODE
+2 SET ZNODE=$SELECT(ACTION="ADD":PXKAFT(0),1:PXKBEF(0))
+3 SET HFIEN=$PIECE(ZNODE,U,1)
+4 SET VFDATA("DFN")=$PIECE(ZNODE,U,2)
+5 SET VFDATA("VISIT")=$PIECE(ZNODE,U,3)
+6 SET VFDATA("MAPPED SOURCE")="9999999.64;"_HFIEN
+7 IF ACTION="ADD"
Begin DoDot:1
+8 SET VFDATA("EVENT DATE AND TIME")=$PIECE(PXKAFT(12),U,1)
+9 SET VFDATA("PACKAGE")=$PIECE(PXKAFT(812),U,2)
+10 SET VFDATA("DATA SOURCE")=$PIECE(PXKAFT(812),U,3)
+11 SET CODEDT=VFDATA("EVENT DATE AND TIME")
+12 IF (CODEDT="")!(CODEDT="@")
SET CODEDT=$PIECE(^AUPNVSIT(VFDATA("VISIT"),0),U,1)
End DoDot:1
+13 ;Process the list of mapped codes.
+14 SET IND=0
+15 FOR
SET IND=+$ORDER(^AUTTHF(HFIEN,210,IND))
if IND=0
QUIT
Begin DoDot:1
+16 SET TEMP=^AUTTHF(HFIEN,210,IND,0)
+17 SET CODESYS=$PIECE(TEMP,U,1)
SET CODE=$PIECE(TEMP,U,2)
+18 ;If the code is inactive do not add it.
+19 IF (ACTION="ADD")
IF ('$$ISCACT^PXLEX(CODESYS,CODE,CODEDT))
QUIT
+20 DO VSC(ACTION,CODESYS,CODE,.VFDATA)
End DoDot:1
+21 QUIT
+22 ;
+23 ;================================
PED(ACTION) ;
+1 NEW CODE,CODEDT,CODESYS,EDUIEN,IND,TEMP,VFDATA,ZNODE
+2 SET ZNODE=$SELECT(ACTION="ADD":PXKAFT(0),1:PXKBEF(0))
+3 SET EDUIEN=$PIECE(ZNODE,U,1)
+4 SET VFDATA("DFN")=$PIECE(ZNODE,U,2)
+5 SET VFDATA("VISIT")=$PIECE(ZNODE,U,3)
+6 SET VFDATA("MAPPED SOURCE")="9999999.09;"_EDUIEN
+7 IF ACTION="ADD"
Begin DoDot:1
+8 SET VFDATA("EVENT DATE AND TIME")=$PIECE(PXKAFT(12),U,1)
+9 SET VFDATA("PACKAGE")=$PIECE(PXKAFT(812),U,2)
+10 SET VFDATA("DATA SOURCE")=$PIECE(PXKAFT(812),U,3)
+11 SET CODEDT=VFDATA("EVENT DATE AND TIME")
+12 IF (CODEDT="")!(CODEDT="@")
SET CODEDT=$PIECE(^AUPNVSIT(VFDATA("VISIT"),0),U,1)
End DoDot:1
+13 ;Process the list of mapped codes.
+14 SET IND=0
+15 FOR
SET IND=+$ORDER(^AUTTEDT(EDUIEN,210,IND))
if IND=0
QUIT
Begin DoDot:1
+16 SET TEMP=^AUTTEDT(EDUIEN,210,IND,0)
+17 SET CODESYS=$PIECE(TEMP,U,1)
SET CODE=$PIECE(TEMP,U,2)
+18 ;If the code is inactive do not add it.
+19 IF (ACTION="ADD")
IF ('$$ISCACT^PXLEX(CODESYS,CODE,CODEDT))
QUIT
+20 DO VSC(ACTION,CODESYS,CODE,.VFDATA)
End DoDot:1
+21 QUIT
+22 ;
+23 ;================================
VSC(ACTION,CODESYS,CODE,VFDATA) ;Add or delete a mapped Standard code.
+1 NEW AFTER,BEFORE,CODEDT,FDA,FDAIEN,MSG
+2 ;Delete.
+3 IF ACTION="DEL"
Begin DoDot:1
+4 NEW IEN
+5 SET IEN=""
+6 FOR
SET IEN=+$ORDER(^AUPNVSC("AD",VFDATA("VISIT"),IEN))
if IEN=0
QUIT
Begin DoDot:2
+7 ;Do not delete unless the code and mapped source match.
+8 IF $PIECE(^AUPNVSC(IEN,0),U,1)'=CODE
QUIT
+9 IF VFDATA("MAPPED SOURCE")'=$PIECE($GET(^AUPNVSC(IEN,300)),U,1)
QUIT
+10 ;If BEFORE is null and AFTER is not then the entry is being deleted
+11 ;is being deleted so delete ^TMP("PXKCO",$J,VFDATA("VISIT"),"SC").
+12 SET AFTER=$GET(^TMP("PXKCO",$JOB,VFDATA("VISIT"),"SC",IEN,0,"AFTER"))
+13 SET BEFORE=$GET(^TMP("PXKCO",$JOB,VFDATA("VISIT"),"SC",IEN,0,"BEFORE"))
+14 IF (AFTER'="")
IF (BEFORE="")
KILL ^TMP("PXKCO",$JOB,VFDATA("VISIT"),"SC",IEN)
+15 IF '$TEST
Begin DoDot:3
+16 SET ^TMP("PXKCO",$JOB,VFDATA("VISIT"),"SC",IEN,0,"AFTER")=""
+17 SET ^TMP("PXKCO",$JOB,VFDATA("VISIT"),"SC",IEN,0,"BEFORE")=^AUPNVSC(IEN,0)
End DoDot:3
+18 SET FDA(9000010.71,IEN_",",.01)="@"
+19 DO FILE^DIE("","FDA","MSG")
+20 ;If the deletion failed send an error message and remove the event
+21 ;point ^TMP("PXKCO") nodes.
+22 IF $DATA(MSG)
Begin DoDot:3
+23 NEW SUBJECT
+24 SET SUBJECT="V STANDARD CODES mapped code deletion failed for file #"_$PIECE(VFDATA("MAPPED SOURCE"),";",1)_", IEN="_$PIECE(VFDATA("MAPPED SOURCE"),";",2)
+25 DO SENDEMSG^PXMCLINK(SUBJECT,.MSG)
+26 ;If this is being called from List Manager display the error on
+27 ;the screen.
+28 IF $DATA(VALMCC)
DO ERRORLM(SUBJECT,.MSG)
+29 ;If this is being called from DATA2PCE return the error arrays.
+30 IF '$DATA(VALMCC)
DO ERRORD2P("V STANDARD CODES",SUBJECT,.MSG)
+31 KILL ^TMP("PXKCO",$JOB,VFDATA("VISIT"),"SC",IEN,0,"AFTER")
+32 KILL ^TMP("PXKCO",$JOB,VFDATA("VISIT"),"SC",IEN,0,"BEFORE")
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
QUIT
+33 ;
+34 ;Add.
+35 IF ACTION'="ADD"
QUIT
+36 ;If it is an exact duplicate do not add it.
+37 SET CODEDT=VFDATA("EVENT DATE AND TIME")
+38 IF CODEDT=""
SET CODEDT=$PIECE(^AUPNVSIT(VFDATA("VISIT"),0),U,1)
+39 IF $$VSCDUP(CODESYS,CODE,VFDATA("VISIT"),CODEDT,VFDATA("MAPPED SOURCE"))
QUIT
+40 SET FDA(9000010.71,"+1,",.01)=CODE
+41 SET FDA(9000010.71,"+1,",.02)=VFDATA("DFN")
+42 SET FDA(9000010.71,"+1,",.03)=VFDATA("VISIT")
+43 SET FDA(9000010.71,"+1,",.05)=CODESYS
+44 SET FDA(9000010.71,"+1,",300)=VFDATA("MAPPED SOURCE")
+45 SET FDA(9000010.71,"+1,",1201)=VFDATA("EVENT DATE AND TIME")
+46 SET FDA(9000010.71,"+1,",81202)=VFDATA("PACKAGE")
+47 SET FDA(9000010.71,"+1,",81203)=VFDATA("DATA SOURCE")
+48 DO UPDATE^DIE("S","FDA","FDAIEN","MSG")
+49 IF $DATA(MSG)
Begin DoDot:1
+50 NEW SUBJECT
+51 SET SUBJECT="V STANDARD CODES mapped code filing failed for file #"_$PIECE(VFDATA("MAPPED SOURCE"),";",1)_", IEN="_$PIECE(VFDATA("MAPPED SOURCE"),";",2)
+52 DO SENDEMSG^PXMCLINK(SUBJECT,.MSG)
+53 IF $DATA(VALMCC)
DO ERRORLM(SUBJECT,.MSG)
+54 IF '$DATA(VALMCC)
DO ERRORD2P("V STANDARD CODES",SUBJECT,.MSG)
End DoDot:1
QUIT
+55 SET ^TMP("PXKCO",$JOB,VFDATA("VISIT"),"SC",FDAIEN(1),0,"AFTER")=^AUPNVSC(FDAIEN(1),0)
+56 SET ^TMP("PXKCO",$JOB,VFDATA("VISIT"),"SC",FDAIEN(1),12,"AFTER")=$GET(^AUPNVSC(FDAIEN(1),12))
+57 SET ^TMP("PXKCO",$JOB,VFDATA("VISIT"),"SC",FDAIEN(1),300,"AFTER")=$GET(^AUPNVSC(FDAIEN(1),300))
+58 SET ^TMP("PXKCO",$JOB,VFDATA("VISIT"),"SC",FDAIEN(1),811,"AFTER")=$GET(^AUPNVSC(FDAIEN(1),811))
+59 SET ^TMP("PXKCO",$JOB,VFDATA("VISIT"),"SC",FDAIEN(1),812,"AFTER")=$GET(^AUPNVSC(FDAIEN(1),812))
+60 SET ^TMP("PXKCO",$JOB,VFDATA("VISIT"),"SC",FDAIEN(1),0,"BEFORE")=""
+61 SET ^TMP("PXKCO",$JOB,VFDATA("VISIT"),"SC",FDAIEN(1),12,"BEFORE")=""
+62 SET ^TMP("PXKCO",$JOB,VFDATA("VISIT"),"SC",FDAIEN(1),300,"BEFORE")=""
+63 SET ^TMP("PXKCO",$JOB,VFDATA("VISIT"),"SC",FDAIEN(1),811,"BEFORE")=""
+64 SET ^TMP("PXKCO",$JOB,VFDATA("VISIT"),"SC",FDAIEN(1),812,"BEFORE")=""
+65 QUIT
+66 ;
+67 ;================================
VSCDUP(CODESYS,CODE,VISITIEN,CODEDT,MSOURCE) ;Determine if the standard code is
+1 ; already on the encounter.
+2 NEW DUP,EVENTDT,MSRC,TEMP,VSCIEN
+3 SET (DUP,VSCIEN)=0
+4 FOR
if DUP
QUIT
SET VSCIEN=+$ORDER(^AUPNVSC("AD",VISITIEN,VSCIEN))
if VSCIEN=0
QUIT
Begin DoDot:1
+5 SET TEMP=^AUPNVSC(VSCIEN,0)
+6 SET CSYS=$PIECE(TEMP,U,1)
+7 IF $PIECE(TEMP,U,5)'=CODESYS
QUIT
+8 IF $PIECE(TEMP,U,1)'=CODE
QUIT
+9 SET EVENTDT=$PIECE($GET(^AUPNVSC(VSCIEN,12)),U,1)
+10 IF EVENTDT=""
SET EVENTDT=$PIECE(^AUPNVSIT(VISITIEN,0),U,1)
+11 IF EVENTDT'=CODEDT
QUIT
+12 SET MSRC=$PIECE($GET(^AUPNVSC(VSCIEN,300)),U,1)
+13 ;If the coding system, code, date, and mapped source match it
+14 ;is a duplicate.
+15 IF MSRC=MSOURCE
SET DUP=1
End DoDot:1
+16 QUIT DUP
+17 ;
+18 ;================================
XAM(ACTION) ;
+1 NEW CODE,CODEDT,CODESYS,EXAMIEN,IND,TEMP,VFDATA,ZNODE
+2 SET ZNODE=$SELECT(ACTION="ADD":PXKAFT(0),1:PXKBEF(0))
+3 SET EXAMIEN=$PIECE(ZNODE,U,1)
+4 SET VFDATA("DFN")=$PIECE(ZNODE,U,2)
+5 SET VFDATA("VISIT")=$PIECE(ZNODE,U,3)
+6 SET VFDATA("MAPPED SOURCE")="9999999.15;"_EXAMIEN
+7 IF ACTION="ADD"
Begin DoDot:1
+8 SET VFDATA("EVENT DATE AND TIME")=$PIECE(PXKAFT(12),U,1)
+9 SET VFDATA("PACKAGE")=$PIECE(PXKAFT(812),U,2)
+10 SET VFDATA("DATA SOURCE")=$PIECE(PXKAFT(812),U,3)
+11 SET CODEDT=VFDATA("EVENT DATE AND TIME")
+12 IF (CODEDT="")!(CODEDT="@")
SET CODEDT=$PIECE(^AUPNVSIT(VFDATA("VISIT"),0),U,1)
End DoDot:1
+13 ;Process the list of mapped codes.
+14 SET IND=0
+15 FOR
SET IND=+$ORDER(^AUTTEXAM(EXAMIEN,210,IND))
if IND=0
QUIT
Begin DoDot:1
+16 SET TEMP=^AUTTEXAM(EXAMIEN,210,IND,0)
+17 SET CODESYS=$PIECE(TEMP,U,1)
SET CODE=$PIECE(TEMP,U,2)
+18 ;If the code is inactive do not add it.
+19 IF (ACTION="ADD")
IF ('$$ISCACT^PXLEX(CODESYS,CODE,CODEDT))
QUIT
+20 DO VSC(ACTION,CODESYS,CODE,.VFDATA)
End DoDot:1
+21 QUIT
+22 ;
