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

AUMI10D.m

Go to the documentation of this file. 
  1. AUMI10D ;IHS/OIT/NKD - DRIVER FOR ICD10 - 09/04/2018 ;
  1.  ;;19.0;ICD UPDATE;;SEP 04,2018;Build 1
  1.  ;
  1.  Q
  1. POST ; EP - MAIN EP FR KIDS
  1.  N HDR,ONE,AT,TAG,TMP,LOG,CNT,AUMDT
  1.  S HDR="",ONE=1,AT="@",AUMDT=$G(^TMP("AUM",$J,"AUMDT"),$P($$NOW^XLFDT(),"."))
  1.  ; BUILD MAP IN TMP
  1.  F TAG="CM","PCS" S LOG=$NA(^TMP("AUM",$J,TAG)) D
  1.  . S TMP=$O(^ICDS("B",$S(TAG="CM":"ICD-10-CM",TAG="PCS":"ICD-10-PCS",1:0),0)),TMP=$S(TMP:TMP,TAG="CM":30,TAG="PCS":31,1:0) Q:'TMP
  1.  . S @LOG=TMP_U_$G(^ICDS(TMP,0))
  1.  . F CNT=1:1 S TMP=$P($T(@(TAG)+CNT^AUMI10M),";;",2) Q:TMP="END"  S @LOG@("M",TMP)=$P($T(@(TAG)+CNT^AUMI10M),";;",3),@LOG@("M",TMP,$P($T(@(TAG)+CNT^AUMI10M),";;",4))=""
  1.  . F CNT=1:1 S TMP=$P($T(@(TAG_"D")+CNT^AUMI10M),";;",2) Q:TMP="END"  S @LOG@($E(TMP))=$P($T(@(TAG_"D")+CNT^AUMI10M),";;",3)
  1.  ; ITERATE THROUGH ENTRIES
  1.  D RSLT($$REPEAT^XLFSTR("-",20))
  1.  S CNT=0 F  S CNT=$O(^AUMDATA(CNT)) Q:'CNT  D
  1.  . S TAG=$P($G(^AUMDATA(CNT,0)),U,2)
  1.  . I $P($G(^AUMDATA(CNT-1,0)),U,2)'=TAG D HDR(TAG)
  1.  . S ^TMP("AUM",$J,TAG,"C")=+$G(^TMP("AUM",$J,TAG,"C"))+1
  1.  . D ENTRY(TAG,$P($G(^AUMDATA(CNT,0)),U,3,99),$NA(^TMP("AUM",$J,CNT)))
  1.  . I $P($G(^AUMDATA(CNT+1,0)),U,2)'=TAG D FTR(TAG)
  1.  ;
  1.  Q
  1.  ;
  1. ENTRY(AUMT,AUMD,AUML) ; MAIN UPDATE DRIVER
  1.  N P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P5A,INA,AUMC
  1.  ; E=ERROR,I=IEN,M=MODIFY,P=PRINT
  1.  N AUME,AUMI,AUMM,AUMP
  1.  S (AUMI,AUMM)="",AUMP=0,INA=0,AUMT=$G(AUMT),AUMD=$G(AUMD),AUML=$G(AUML)
  1.  F AUMC=1:1:12 S @("P"_AUMC)=$P(AUMD,U,AUMC)
  1.  ; PRE-UPDATE
  1.  D @(AUMT_"PRE^AUMI10U")
  1.  ; SEARCH
  1.  S:'AUMI AUMI=$$SEARCH(P1)
  1.  ; INACTIVATE
  1.  I INA D INACT
  1.  ; NEW
  1.  I 'INA,'AUMI D NEW
  1.  Q:'AUMI
  1.  ; UPDATE
  1.  I 'INA D UPDATE
  1.  ; DRG
  1.  I 'INA D @(AUMT_"DRG^AUMI10U")
  1.  ; DISPLAY
  1.  D DISP
  1.  ;
  1.  Q
  1.  ;
  1.  N AUMI
  1.  ; SEARCH BY CODE/SYS
  1.  S AUMI=+$$CODEABA^ICDEX(AUMC,$$SYS(AUMT,4),$$SYS(AUMT,1))
  1.  ; IF FOUND, STORE RESULTS OF API CALL (FOR COMPARISON)
  1.  I AUMI>0,$$SYS(AUMT,4)=80 S @AUML=$$ICDDX^ICDEX(AUMI,AUMDT,$$SYS(AUMT,1),"I")_U_(+$P($G(^ICD9(AUMI,1)),U,9))
  1.  I AUMI>0,$$SYS(AUMT,4)=80.1 S @AUML=$$ICDOP^ICDEX(AUMI,AUMDT,$$SYS(AUMT,1),"I")
  1.  ;
  1.  Q $S(AUMI>0:AUMI,1:0)
  1.  ;
  1. NEW ; GENERIC NEW ENTRY DRIVER
  1.  N FDA,NEWIEN,ERR
  1.  ;
  1.  S FDA($$SYS(AUMT,4),"+1,",.01)=P1
  1.  S FDA($$SYS(AUMT,4),"+1,",1.1)=$$SYS(AUMT,1)
  1.  S NEWIEN(1)=$$IEN^AUMI10U($$SYS(AUMT,1))  ; GET NEXT AVAILABLE IEN BASED ON SYS
  1.  ;
  1.  D RLOG(AUML,"P1",,P1),UPDATE^DIE(,"FDA","NEWIEN","ERR")
  1.  S AUMM="NEW :",AUMI=NEWIEN(1)
  1.  I $D(ERR) D ERR("SYSTEM ERROR - New entry failed")
  1.  ;
  1.  Q
  1.  ;
  1. UPDATE ; GENERIC UPDATE DRIVER
  1.  N AUMV,AUMFR,AUMTO,AUMCP,AUMNL,AUMFI,AUMFL,FDA,ERR
  1.  ; ITERATE THROUGH MAPPED PIECES
  1.  S AUMV="" F  S AUMV=$O(^TMP("AUM",$J,AUMT,"M",AUMV)) Q:AUMV']""  D
  1.  . ; CP=COMPARE POINT, NL=NULL VALUE, FI=FILE #, FL=FIELD #
  1.  . S AUMCP=$$MAP(AUMT,AUMV,1),AUMNL=$$MAP(AUMT,AUMV,2),AUMFI=$$MAP(AUMT,AUMV,3),AUMFL=$$MAP(AUMT,AUMV,4)
  1.  . ; COMPARISON LOGIC
  1.  . Q:'$D(@AUMV)  S AUMTO=$G(@AUMV)  ; TO VALUE
  1.  . S AUMFR=$S(AUMCP?1N.N:$P($G(@AUML),U,AUMCP),AUMCP="VLT":$$VLT^ICDEX($$SYS(AUMT,4),AUMI,AUMDT),1:"")  ; FROM VALUE
  1.  . S:'$L(AUMFR) AUMFR=AUMNL S:'$L(AUMTO) AUMTO=AUMNL  ; CONVERT ANY NULL VALUE
  1.  . Q:AUMFR=AUMTO  ; QUIT IF NO CHANGE
  1.  . ; BUILD FDA USING TO VALUES
  1.  . D RLOG(AUML,AUMV,AUMFR,AUMTO)
  1.  . I AUMFI=$$SYS(AUMT,4) S FDA(AUMFI,AUMI_",",AUMFL)=AUMTO Q  ; IF MAIN FILE, DON'T USE SUB-FILE LOGIC
  1.  . I AUMV="P7",$D(FDA(AUMFI)) S FDA(AUMFI,"?+6,"_AUMI_",",AUMFL)=AUMTO Q  ; IF P6 CHANGED, USE THAT SUB-FILE PLACEHOLDER
  1.  . S FDA(AUMFI,"?+"_+$TR(AUMV,"P")_","_AUMI_",",.01)=AUMDT
  1.  . S FDA(AUMFI,"?+"_+$TR(AUMV,"P")_","_AUMI_",",AUMFL)=AUMTO
  1.  . I AUMV="P7" S FDA(AUMFI,"?+7,"_AUMI_",",1)=$S($L($G(P6)):$G(P6),1:0)  ; IF P7 CHANGED BUT NOT P6, ADD P6 TO SUB-FILE CREATION
  1.  ;
  1.  I $D(FDA) D UPDATE^DIE(,"FDA",,"ERR") S:'$L(AUMM) AUMM="MOD :"
  1.  I $D(ERR) D ERR("SYSTEM ERROR - Update failed")
  1.  ;
  1.  Q
  1.  ;
  1. INACT ; GENERIC INACTIVATE DRIVER
  1.  N AUMV,AUMNL,AUMFI,AUMFL,FDA,ERR I 'AUMI D TAGCNT Q
  1.  ; ITERATE THROUGH MAPPED PIECES
  1.  S AUMV="" F  S AUMV=$O(^TMP("AUM",$J,AUMT,"M",AUMV)) Q:AUMV']""  D
  1.  . ; NL=NULL VALUE, FI=FILE #, FL=FIELD #
  1.  . S AUMNL=$$MAP(AUMT,AUMV,2),AUMFI=$$MAP(AUMT,AUMV,3),AUMFL=$$MAP(AUMT,AUMV,4)
  1.  . ; ONLY NULL OUT STATUS FIELD
  1.  . Q:'$D(@AUMV)  Q:+$TR(AUMV,"P")>2
  1.  . ; BUILD FDA USING DEFINED NULL VALUES
  1.  . I AUMFI=$$SYS(AUMT,4) S FDA(AUMFI,AUMI_",",AUMFL)=AUMNL Q  ; IF MAIN FILE, DON'T USE SUB-FILE LOGIC
  1.  . I AUMV="P7",$D(FDA(AUMFI)) S FDA(AUMFI,"?+6,"_AUMI_",",AUMFL)=AUMNL Q  ; IF P6 CHANGED, USE THAT SUB-FILE PLACEHOLDER
  1.  . S FDA(AUMFI,"?+"_+$TR(AUMV,"P")_","_AUMI_",",.01)=AUMDT
  1.  . S FDA(AUMFI,"?+"_+$TR(AUMV,"P")_","_AUMI_",",AUMFL)=AUMNL
  1.  ;
  1.  I $D(FDA) D RLOG(AUML,"P2",1,0),UPDATE^DIE(,"FDA",,"ERR") S AUMM="INA :"
  1.  I $D(ERR) D ERR("SYSTEM ERROR - Inactivate failed")
  1.  ;
  1.  Q
  1.  ;
  1. DISP ; GENERIC DISPLAY DRIVER
  1.  N AUMF1,AUMF2,AUMF3,AUMF4,AUMC,INAD,AUMS,AUMH,AUMD0,AUMD1,AUMV Q:AUMP
  1.  ;
  1.  S AUMS="",AUMP=1,INAD=$S(INA:"I",1:"") I AUMM]"" D
  1.  . S AUMD0=$G(^TMP("AUM",$J,AUMT,"D")) F AUMC=1:1:$L(AUMD0,";") S AUMD1=$P(AUMD0,";",AUMC) D
  1.  . . S AUMF1=$P(AUMD1,"|",1),AUMF2=$P(AUMD1,"|",2),AUMF3=$P(AUMD1,"|",3),AUMF4=$P(AUMD1,"|",4),AUMV=""
  1.  . . S AUMV=$E($S('AUMF3:$G(@AUMF1),AUMF3>1:$P($G(@AUML@("R",AUMF1)),U,AUMF3),1:""),1,AUMF2)
  1.  . . I '$L(AUMV),AUMF3>1,$L($G(@AUML@("R",AUMF1))) S AUMV="@"
  1.  . . I $L(AUMV),$L(AUMF4) S AUMV=AUMF4
  1.  . . S AUMS=AUMS_AUMV_$J("",AUMF2+1-$L(AUMV))
  1.  . D RSLT(AUMS)
  1.  ;
  1.  D TAGCNT
  1.  ;
  1.  Q
  1.  ;
  1. SYS(T,P)  ; EP - RETURN SYS DATA
  1.  S T=$G(T,$G(AUMT)),P=$G(P,1) Q $S('$L(T):"",1:$P($G(^TMP("AUM",$J,T)),U,P))
  1.  ;
  1. MAP(T,V,P)  ; RETURN MAP DATA
  1.  S T=$G(T,$G(AUMT)),V=$G(V),P=$G(P,1) Q $S('$L(T)!('$L(V)):"",1:$P($G(^TMP("AUM",$J,T,"M",V)),U,P))
  1.  ;
  1. RLOG(GL,VN,V1,V2)  ; EP - LOG RESULT TO TMP
  1.  S GL=$G(GL),VN=$G(VN),V1=$G(V1),V2=$G(V2) Q:'$L(GL)  Q:'$L(VN)
  1.  S @GL@("R",VN)=V1_U_V2
  1.  Q
  1.  ;
  1. TAGCNT ; UPDATE LOCAL MODIFICATION COUNT AND DISPLAY IF TOTAL REACHED
  1.  N AUMA,AUMV,AUMF
  1.  ;
  1.  S AUMA=$S($L($P(AUMM," ")):$P(AUMM," "),1:"UNM")
  1.  S ^TMP("AUM",$J,AUMT,"C",AUMA)=+$G(^TMP("AUM",$J,AUMT,"C",AUMA))+1
  1.  Q:AUMA'="MOD"
  1.  ;
  1.  S AUMF="" F  S AUMF=$O(@AUML@("R",AUMF)) Q:'$L(AUMF)  D
  1.  . S AUMV=$S($E(AUMF)="P":$O(^TMP("AUM",$J,AUMT,"M",AUMF,"")),1:AUMF) S:'$L(AUMV) AUMV="UNKNOWN"
  1.  . S ^TMP("AUM",$J,AUMT,"C","F",AUMV)=+$G(^TMP("AUM",$J,AUMT,"C","F",AUMV))+1
  1.  ;
  1.  Q
  1.  ;
  1. HDR(AUMT)  ; DISPLAY TABLE HEADER
  1.  N AUMS,AUMF0,AUMF1,AUMF2,AUMF3,AUMC S AUMT=$G(AUMT) Q:'$L(AUMT)  Q:'$D(^TMP("AUM",$J,AUMT,"H"))
  1.  ;
  1.  S AUMF0=$G(^TMP("AUM",$J,AUMT,"H"))
  1.  S AUMF1=$P(AUMF0,U),AUMS=$P(AUMF1,";",2) D RSLT(AUMS,1)
  1.  S AUMF1=$P(AUMF0,U,2),AUMS="" F AUMC=1:1:$L(AUMF1,";") S AUMF2=$P($P(AUMF1,";",AUMC),"|"),AUMF3=$P($P(AUMF1,";",AUMC),"|",2),AUMS=AUMS_$J("",AUMF3-$L(AUMS))_AUMF2
  1.  ;
  1.  D RSLT(AUMS),RSLT($TR(AUMS,"ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890-",$$REPEAT^XLFSTR("=",37)))
  1.  ;
  1.  Q
  1.  ;
  1. FTR(AUMT)  ; DISPLAY TABLE FOOTER
  1.  N AUMA,AUMC,TOT S TOT=+$G(^TMP("AUM",$J,AUMT,"C")) D RSLT("") I 'TOT D RSLT($$REPEAT^XLFSTR("-",20)) Q
  1.  ;
  1.  F AUMA="NEW","MODIFIED","INACTIVE","ERROR","UNMODIFIED" D
  1.  . S AUMC=+$G(^TMP("AUM",$J,AUMT,"C",$E(AUMA,1,3))) Q:'AUMC
  1.  . D RSLT(AUMA_$$REPEAT^XLFSTR(".",15-$L(AUMA))_AUMC)
  1.  . Q:AUMA'="MODIFIED"
  1.  . S AUMC="" F  S AUMC=$O(^TMP("AUM",$J,AUMT,"C","F",AUMC)) Q:'$L(AUMC)  D RSLT("  "_AUMC_$$REPEAT^XLFSTR(".",13-$L(AUMC))_(+$G(^TMP("AUM",$J,AUMT,"C","F",AUMC))))
  1.  D RSLT("TOTAL.........."_TOT),RSLT($$REPEAT^XLFSTR("-",20))
  1.  ;
  1.  Q
  1.  ;
  1. RSLT(%,LINE) ; ISSUE MESSAGES DURING INSTALL
  1.  I $D(LINE) D MES^XPDUTL("")
  1.  D MES^XPDUTL(%)
  1.  Q
  1.  ;
  1. ERR(%) ; ERROR MESSAGES
  1.  S:'INA AUME="",AUMM="ERR :"
  1.  D DISP,RSLT($J("",2)_%)
  1.  K DIERR
  1.  Q
  1.  ;