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