- 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 Feb 18, 2025@23:55:48 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 ;