AUMSCBD ;IHS/OIT/NKD - SCB UPDATE - DRIVER 12/07/2012 ;
;;19.0;TABLE MAINTENANCE;**1**;SEP 04,2018;Build 1
; 03/12/14 - Modified processing/display for ADD/DEL tags
; - Modified debug to include ADD changes
; 12/16/14 - Removed old/unused code
; 05/29/15 - Added Clinic report
; 06/03/16 - Enhancement to WP array processing
Q
;Called at POST by KIDS for AUM updates
POST ; EP -- MAIN EP
N AUMCNT,HDR,ONE,AT,AUMDT,AUMT,AUMA,CNT
S AUMCNT=0,HDR="",ONE=1,AT="@",AUMDT=$P($$NOW^XLFDT(),".")
F S AUMCNT=$O(^AUMDATA(AUMCNT)) Q:'AUMCNT D
. N AUMT,AUMA,CNT
. S AUMT=$P(^AUMDATA(AUMCNT,0),U,2),AUMA=""
. F CNT="ADD","INA","DEL","ALL" Q:$L(AUMA)>0 S:$E(AUMT,$L(AUMT)-2,$L(AUMT))=CNT AUMA=$E(AUMT,$L(AUMT)-2,$L(AUMT)),AUMT=$E(AUMT,1,$L(AUMT)-3)
. I AUMA="ALL" D Q
. . S:'$D(^TMP("AUM",$J,"ALL",AUMT,0)) ^TMP("AUM",$J,"ALL",AUMT,0)=0
. . S ^TMP("AUM",$J,"ALL",AUMT,^TMP("AUM",$J,"ALL",AUMT,0)+1)=$P(^AUMDATA(AUMCNT,0),U,3,9),^TMP("AUM",$J,"ALL",AUMT,0)=^TMP("AUM",$J,"ALL",AUMT,0)+1
. D ENTRY(AUMT,AUMA,$P(^AUMDATA(AUMCNT,0),U,3,9))
I $D(^TMP("AUM",$J,"ALL")) D ALL^AUMSCBA
D RSLT($$REPEAT^XLFSTR("-",20))
I HDR["EDT" D PKLST^AUMSCBU
I HDR["CLIN" D CLINIC^AUMSCBU ; IHS/OIT/NKD AUM*15.0*3 - ADDED CLINIC REPORT
Q
ENTRY(AUMT,AUMA,L,AUMAIEN,AUMQ) ; MAIN UPDATE DRIVER
N P1,P2,P3,P4,P5,P6,P7,P1A,P2A,P3A,P4A,P5A,P6A,P7A,L1,F1,F2,F3
N FDA,NEWIEN,ERR,CNT,CNT2,TEXT,INA,INAD
; D=DATA,E=ERROR,I=IEN,L=LIST,M=MODIFY,P=PRINT,R=RESULT,S=STRING
N AUMD,AUME,AUMI,AUML,AUMM,AUMP,AUMR,AUMS
S (AUMI,AUMM,AUML)="",AUMP=0,INA=$S(AUMA="INA":1,AUMA="DEL":1,1:0)
F CNT=1:1:7 S @("P"_CNT)=$P(L,U,CNT),@("P"_CNT_"A")=""
F CNT=1:1 S TEXT=$P($T(@(AUMT)+CNT^AUMSCBM),";;",2) Q:TEXT="END" D
. S AUMD(TEXT)=$P($T(@(AUMT)+CNT^AUMSCBM),";;",3)
; PRE-UPDATE
I $D(AUMD("PRE")) D @(AUMD("PRE"))
Q:$D(AUME)
; SEARCH
S:$D(AUMAIEN) AUMI=AUMAIEN
S:'AUMI&$D(AUMD("SEA")) AUMI=$$SEARCH(AUMD("SEA"))
; INACTIVATE
I INA,$D(AUMD("INA")) D INACT
; NEW
I 'INA,'AUMI,$D(AUMD("NEW")) D NEW
Q:'AUMI
; UPDATE
I 'INA,$D(AUMD("UPD")) D UPDATE
; WP
I $D(AUMD("WP")) D WP
; POST-UPDATE
I $D(AUMD("POS")) D @(AUMD("POS")) Q
; DISPLAY
I $D(AUMD("DSP")) D DISP Q
D RSLT(AUMT_": "_L)
Q
SEARCH(AUMD) ; EP - GENERIC SEARCH DRIVER - PICKS HIGHEST IEN IF MULTIPLE RESULTS FOUND
N F1,F2,F3,CNT,CNT2,AUMR,AUMI
S F1=$P(AUMD,U,1),F2=$P(AUMD,U,2),AUMI=""
F CNT=1:1:$L(F2,";") Q:AUMI]"" D
. S F3=$P(F2,";",CNT)
. I '$D(@$P(F3,"|",1)) D ERR("SYSTEM ERROR - Unassigned local variable: "_$P(F3,"|",1)) Q
. D FIND^DIC(F1,"","@;.01","PX",@$P(F3,"|",1),,$P(F3,"|",2),,,"AUMR")
. S CNT2=$P($G(AUMR("DILIST",0)),U,1)
. S AUMI=$S(CNT2=1:$P($G(AUMR("DILIST",1,0)),U,1),CNT2>1:$P($G(AUMR("DILIST",$P($G(AUMR("DILIST",0)),U,1),0)),U,1),1:"")
Q AUMI
INACT ; GENERIC INACTIVATE DRIVER
N FDA,ERR,F1,F2,F3,CNT,AUMR
I 'AUMI S AUMM=AUMA_" :" D ERR("Entry not found to INACTIVATE (ok)") Q
; CUSTOM INACTIVATE CHECK
I AUMD("INA")'["|" D @(AUMD("INA")) Q
S F1=$P(AUMD("INA"),U,1),F2=$P(AUMD("INA"),U,2),AUMR=""
F CNT=1:1:$L(F2,";") D
. S F3=$P(F2,";",CNT)
. I '$D(@$P(F3,"|",2)) D ERR("SYSTEM ERROR - Unassigned local variable: "_$P(F3,"|",2)) Q
. Q:(@$P(F3,"|",2))']""
. Q:($$GET1^DID(F1,$P(F3,"|",1),"","LABEL")']"")
. S FDA(F1,AUMI_",",$P(F3,"|",1))=@$P(F3,"|",2)
. S AUMR=AUMR_$P(F3,"|",1)_"|"_$TR($$GET1^DIQ(F1,AUMI,$P(F3,"|",1),"I"),U,";;")_"|"_$P(F3,"|",2)_U
D UPDATE^DIE($S($L($P(AUMD("INA"),U,3))<1:"E",1:""),"FDA",,"ERR")
I $D(ERR) D ERR("SYSTEM ERROR - Inactivate failed") Q
I AUMM']"" D
. ;I AUMA="DEL" S AUMM=AUMA_" :" Q ; IHS/OIT/NKD AUM*14.0*2 - MODIFIED PROCESSING FOR DEL TAG
. F CNT=1:1:$L(AUMR,U) Q:$P(AUMR,U,CNT)']"" D
. . Q:$$GET1^DIQ(F1,AUMI,$P($P(AUMR,U,CNT),"|",1),"I")=$TR($P($P(AUMR,U,CNT),"|",2),";;",U)
. . Q:$P($P(AUMR,U,CNT),"|",1)=".28"
. . S AUML=AUML_$$GET1^DID(F1,$P($P(AUMR,U,CNT),"|",1),"","LABEL")_"|"_$P($P(AUMR,U,CNT),"|",2)_"|"_@$P($P(AUMR,U,CNT),"|",3)_U
. . S AUMM="INA :"
. . S:AUMA="DEL" AUMM="DEL :" ; IHS/OIT/NKD AUM*14.0*2 - MODIFIED PROCESSING FOR DEL TAG
Q
NEW ; GENERIC NEW ENTRY DRIVER
N FDA,NEWIEN,ERR,F1,F2,F3,CNT
S AUMM="NEW :"
; CUSTOM NEW ENTRY CHECK
I AUMD("NEW")'["|" D @(AUMD("NEW")) Q
S F1=$P(AUMD("NEW"),U,1),F2=$P(AUMD("NEW"),U,2)
F CNT=1:1:$L(F2,";") D
. S F3=$P(F2,";",CNT)
. I '$D(@$P(F3,"|",2)) D ERR("SYSTEM ERROR - Unassigned local variable: "_$P(F3,"|",2)) Q
. Q:(@$P(F3,"|",2))']""
. Q:($$GET1^DID(F1,$P(F3,"|",1),"","LABEL")']"")
. S FDA(F1,"+1,",$P(F3,"|",1))=@$P(F3,"|",2)
D UPDATE^DIE($S($L($P(AUMD("NEW"),U,3))<1:"E",1:""),"FDA","NEWIEN","ERR")
I $D(ERR) D ERR("SYSTEM ERROR - New entry failed") Q
S AUMI=NEWIEN(1)
Q
UPDATE ; GENERIC UPDATE DRIVER
N FDA,ERR,F1,F2,F3,CNT,AUMR
S F1=$P(AUMD("UPD"),U,1),F2=$P(AUMD("UPD"),U,2),AUMR=""
F CNT=1:1:$L(F2,";") D
. S F3=$P(F2,";",CNT)
. I '$D(@$P(F3,"|",2)) D ERR("SYSTEM ERROR - Unassigned local variable: "_$P(F3,"|",2)) Q
. Q:(@$P(F3,"|",2))']""
. Q:($$GET1^DID(F1,$P(F3,"|",1),"","LABEL")']"")
. S FDA(F1,AUMI_",",$P(F3,"|",1))=@$P(F3,"|",2)
. S AUMR=AUMR_$P(F3,"|",1)_"|"_$TR($$GET1^DIQ(F1,AUMI,$P(F3,"|",1),"I"),U,";;")_"|"_$P(F3,"|",2)_U
D UPDATE^DIE($S($L($P(AUMD("UPD"),U,3))<1:"E",1:""),"FDA",,"ERR")
I $D(ERR) D ERR("SYSTEM ERROR - Update failed") Q
I AUMM']"" D
. ;I AUMA=""ADD"" S AUMM=AUMA_"" :"" Q ; IHS/OIT/NKD AUM*14.0*2 - MODIFIED PROCESSING FOR ADD TAG
. F CNT=1:1:$L(AUMR,U) Q:$P(AUMR,U,CNT)']"" D
. . Q:$$GET1^DIQ(F1,AUMI,$P($P(AUMR,U,CNT),"|",1),"I")=$TR($P($P(AUMR,U,CNT),"|",2),";;",U)
. . Q:$P($P(AUMR,U,CNT),"|",1)=".28"
. . S AUML=AUML_$$GET1^DID(F1,$P($P(AUMR,U,CNT),"|",1),"","LABEL")_"|"_$P($P(AUMR,U,CNT),"|",2)_"|"_@$P($P(AUMR,U,CNT),"|",3)_U
. . S AUMM="MOD :"
. . S:AUMA="ADD" AUMM="ADD :" ; IHS/OIT/NKD AUM*14.0*2 - MODIFIED PROCESSING FOR ADD TAG
Q
WP ; GENERIC WORD-PROCESSING DRIVER
N FDA,ERR,F1,F2,F3,CNT
N AUMWP1,AUMWP2
S F1=$P(AUMD("WP"),U,1),F2=$P(AUMD("WP"),U,2)
F CNT=1:1:$L(F2,";") D
. S F3=$P(F2,";",CNT)
. I '$D(@$P(F3,"|",2)) D ERR("SYSTEM ERROR - Unassigned local variable: "_$P(F3,"|",2)) Q
. D TEXT(.@($P(F3,"|",2)))
. S AUMWP1=$$GET1^DIQ(F1,AUMI_",",$P(F3,"|",1),,"AUMWP1")
. D WP^DIE(F1,AUMI_",",$P(F3,"|",1),,$P(F3,"|",2))
. S AUMWP2=$$GET1^DIQ(F1,AUMI_",",$P(F3,"|",1),,"AUMWP2")
. I $$WPCHK(.AUMWP1,.AUMWP2) S AUML=AUML_$$GET1^DID(F1,$P(F3,"|",1),"","LABEL")_U,AUMM=$S(AUMM]"":AUMM,1:"MOD :")
Q
DISP ; EP - GENERIC DISPLAY DRIVER
N F1,F2,F3,CNT,AUMS,AUMH
Q:AUMP
I $D(AUMD("DSP")) D
. S AUMS=""
. S INAD=$S(INA:"I",1:"")
. F CNT=1:1:$L(AUMD("DSP"),";") D
. . S F1=$P($P(AUMD("DSP"),";",CNT),"|",1),F2=$P($P(AUMD("DSP"),";",CNT),"|",2),F3=$P($P(AUMD("DSP"),";",CNT),"|",3)
. . S:F3]"" AUMS=AUMS_$J("",F3-$L(AUMS))
. . S AUMS=AUMS_$E(@F1,1,F2)_$J("",F2+1-$L($E(@F1,1,F2)))
. ; CHECK IF TABLE HEADER NEEDS TO BE DISPLAYED
. I $D(AUMD("HDR")) D
. . S F1=$P(AUMD("HDR"),U,1)
. . Q:$P(HDR,U,$L(HDR,U)-1)=@$P(F1,";",1)
. . D RSLT($$REPEAT^XLFSTR("-",20))
. . S AUMH=""
. . D RSLT(AUMH)
. . S AUMH=$G(^TMP("AUM",$J,"COUNT",@$P(F1,";",1)))_" "_$P(F1,";",2)
. . D RSLT(AUMH)
. . S AUMH=""
. . F CNT=1:1:$L($P(AUMD("HDR"),U,2),";") D
. . . S F2=$P($P($P(AUMD("HDR"),U,2),";",CNT),"|",1),F3=$P($P($P(AUMD("HDR"),U,2),";",CNT),"|",2)
. . . S AUMH=AUMH_$J("",F3-$L(AUMH))_F2
. . D RSLT(AUMH)
. . D RSLT($TR(AUMH,"ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890-",$$REPEAT^XLFSTR("=",37)))
. . S HDR=HDR_@$P(F1,";",1)_U
. I '$G(AUMQ) D RSLT(AUMS),TAGCNT
. I AUMM]"",(($G(AUMQ)=1)!(AUMM["ERR")) D RSLT(AUMS)
. I $G(AUMQ)=1 D TAGCNT
. S AUMP=1
. ;I $D(AUMDEBUG),AUMM'["ERR",AUMM'["NEW",AUMM'["ADD" D ; IHS/OIT/NKD AUM*14.0*2 - DEBUG TO INCLUDE ADD
. I $D(AUMDEBUG),AUMM'["ERR",AUMM'["NEW" D
. . Q:AUML']""
. . F CNT=1:1:$L(AUML,U) I $P(AUML,U,CNT)]"" D RSLT($J("",4)_$P(AUML,U,CNT))
Q
ERR(%) ; EP - ERROR MESSAGES
S:'INA AUME="",AUMM="ERR :"
D DISP,RSLT($J("",2)_%)
Q
RSLT(%) ; EP - ISSUE MESSAGES DURING INSTALL
D MES^XPDUTL(%)
Q
;
CLEAN(X) ; EP - STRING CLEANING UTILITY
N CNT,AUMS
S AUMS=X
S CNT=0 F S CNT=$F(X," -") Q:'CNT S $E(X,CNT-2,CNT-1)="-"
S CNT=0 F S CNT=$F(X,"- ") Q:'CNT S $E(X,CNT-2,CNT-1)="-"
S CNT=0 F S CNT=$F(X," ") Q:'CNT S $E(X,CNT-2,CNT-1)=" "
I $E(X,1)=" " S X=$E(X,2,$L(X))
I $E(X,$L(X))=" " S X=$E(X,1,$L(X)-1)
Q X
TEXT(X) ; EP - STRING TO WP ARRAY USING '|' AS A DELIMITER
N AUMS,I,J
S AUMS=X,I=1,J=1
K X
F I=1:1:$L(AUMS,"|") D
. Q:$L($P(AUMS,"|",I))=0
. ; IHS/OIT/NKD AUM*16.0*3 - START NEW CODE - NICE BREAKING OTHERWISE 80 CHARS
. I $L($P(AUMS,"|",I))>80 D Q
. . N STR S STR=$P(AUMS,"|",I) F Q:'$L(STR) D
. . . N BRK,TRY S BRK=0,TRY=$L(STR) D
. . . . I TRY<81 S BRK=TRY Q
. . . . F TRY=80:-1:2 D Q:BRK
. . . . . I $E(STR,TRY+1)=" " S $E(STR,TRY+1)="",BRK=TRY Q
. . . . . I "&_+-*/<=>}])|:;,.?!"[$E(STR,TRY),$E(STR,TRY+1)=" " S BRK=TRY Q
. . . . S:'BRK BRK=80
. . . S X(J)=$E(STR,1,BRK),J=J+1,$E(STR,1,BRK)=""
. ; IHS/OIT/NKD AUM*16.0*3 - END NEW CODE
. S X(J)=$P(AUMS,"|",I),J=J+1
Q
WPCHK(AUMWP1,AUMWP2) ; COMPARE WP ARRAYS AND RETURN 1 IF NOT EQUAL
N CNT,AUMFR,AUMTO,AUMRES
S AUMRES=0
S CNT=0,AUMFR=0 F S CNT=$O(AUMWP1(CNT)) Q:'CNT S AUMFR=AUMFR+1
S CNT=0,AUMTO=0 F S CNT=$O(AUMWP2(CNT)) Q:'CNT S AUMTO=AUMTO+1
I AUMFR'=AUMTO S AUMRES=1
E F CNT=1:1:AUMTO S:$$CLEAN($G(AUMWP1(CNT)))'=$$CLEAN($G(AUMWP2(CNT))) AUMRES=1
Q AUMRES
TAGCNT ; UPDATE LOCAL MODIFICATION COUNT AND DISPLAY IF TOTAL REACHED
N AUMLA,AUMCNT,AUMCNT2,AUMCNT3
S AUMLA=$P(AUMM," ")
S AUMLA=$S(AUMLA="MOD":"MODIFIED",AUMLA="INA":"INACTIVE",AUMLA="DEL":"DELETE",AUMLA="ERR":"ERROR",1:AUMLA)
S AUMLA=$S(AUMLA]"":AUMLA,1:"UNMODIFIED")
S ^TMP("AUM",$J,"COUNT",AUMT,AUMLA)=$G(^TMP("AUM",$J,"COUNT",AUMT,AUMLA))+1
S AUMCNT=$G(^TMP("AUM",$J,"COUNT",AUMT)),AUMCNT2=0
S AUMCNT3="" F S AUMCNT3=$O(^TMP("AUM",$J,"COUNT",AUMT,AUMCNT3)) Q:AUMCNT3']"" S AUMCNT2=AUMCNT2+$G(^TMP("AUM",$J,"COUNT",AUMT,AUMCNT3))
Q:AUMCNT'=AUMCNT2
D RSLT("")
F AUMCNT3="NEW","ADD","MODIFIED","INACTIVE","DELETE","ERROR","UNMODIFIED" D
. Q:($G(^TMP("AUM",$J,"COUNT",AUMT,AUMCNT3))'>0)
. D RSLT(AUMCNT3_$$REPEAT^XLFSTR(".",11-$L(AUMCNT3))_$G(^TMP("AUM",$J,"COUNT",AUMT,AUMCNT3)))
D RSLT("TOTAL......"_AUMCNT2)
Q
AUMSCBD ;IHS/OIT/NKD - SCB UPDATE - DRIVER 12/07/2012 ;
+1 ;;19.0;TABLE MAINTENANCE;**1**;SEP 04,2018;Build 1
+2 ; 03/12/14 - Modified processing/display for ADD/DEL tags
+3 ; - Modified debug to include ADD changes
+4 ; 12/16/14 - Removed old/unused code
+5 ; 05/29/15 - Added Clinic report
+6 ; 06/03/16 - Enhancement to WP array processing
+7 QUIT
+8 ;Called at POST by KIDS for AUM updates
POST ; EP -- MAIN EP
+1 NEW AUMCNT,HDR,ONE,AT,AUMDT,AUMT,AUMA,CNT
+2 SET AUMCNT=0
SET HDR=""
SET ONE=1
SET AT="@"
SET AUMDT=$PIECE($$NOW^XLFDT(),".")
+3 FOR
SET AUMCNT=$ORDER(^AUMDATA(AUMCNT))
IF 'AUMCNT
QUIT
Begin DoDot:1
+4 NEW AUMT,AUMA,CNT
+5 SET AUMT=$PIECE(^AUMDATA(AUMCNT,0),U,2)
SET AUMA=""
+6 FOR CNT="ADD","INA","DEL","ALL"
IF $LENGTH(AUMA)>0
QUIT
IF $EXTRACT(AUMT,$LENGTH(AUMT)-2,$LENGTH(AUMT))=CNT
SET AUMA=$EXTRACT(AUMT,$LENGTH(AUMT)-2,$LENGTH(AUMT))
SET AUMT=$EXTRACT(AUMT,1,$LENGTH(AUMT)-3)
+7 IF AUMA="ALL"
Begin DoDot:2
+8 IF '$DATA(^TMP("AUM",$JOB,"ALL",AUMT,0))
SET ^TMP("AUM",$JOB,"ALL",AUMT,0)=0
+9 SET ^TMP("AUM",$JOB,"ALL",AUMT,^TMP("AUM",$JOB,"ALL",AUMT,0)+1)=$PIECE(^AUMDATA(AUMCNT,0),U,3,9)
SET ^TMP("AUM",$JOB,"ALL",AUMT,0)=^TMP("AUM",$JOB,"ALL",AUMT,0)+1
End DoDot:2
QUIT
+10 DO ENTRY(AUMT,AUMA,$PIECE(^AUMDATA(AUMCNT,0),U,3,9))
End DoDot:1
+11 IF $DATA(^TMP("AUM",$JOB,"ALL"))
DO ALL^AUMSCBA
+12 DO RSLT($$REPEAT^XLFSTR("-",20))
+13 IF HDR["EDT"
DO PKLST^AUMSCBU
+14 ; IHS/OIT/NKD AUM*15.0*3 - ADDED CLINIC REPORT
IF HDR["CLIN"
DO CLINIC^AUMSCBU
+15 QUIT
ENTRY(AUMT,AUMA,L,AUMAIEN,AUMQ) ; MAIN UPDATE DRIVER
+1 NEW P1,P2,P3,P4,P5,P6,P7,P1A,P2A,P3A,P4A,P5A,P6A,P7A,L1,F1,F2,F3
+2 NEW FDA,NEWIEN,ERR,CNT,CNT2,TEXT,INA,INAD
+3 ; D=DATA,E=ERROR,I=IEN,L=LIST,M=MODIFY,P=PRINT,R=RESULT,S=STRING
+4 NEW AUMD,AUME,AUMI,AUML,AUMM,AUMP,AUMR,AUMS
+5 SET (AUMI,AUMM,AUML)=""
SET AUMP=0
SET INA=$SELECT(AUMA="INA":1,AUMA="DEL":1,1:0)
+6 FOR CNT=1:1:7
SET @("P"_CNT)=$PIECE(L,U,CNT)
SET @("P"_CNT_"A")=""
+7 FOR CNT=1:1
SET TEXT=$PIECE($TEXT(@(AUMT)+CNT^AUMSCBM),";;",2)
IF TEXT="END"
QUIT
Begin DoDot:1
+8 SET AUMD(TEXT)=$PIECE($TEXT(@(AUMT)+CNT^AUMSCBM),";;",3)
End DoDot:1
+9 ; PRE-UPDATE
+10 IF $DATA(AUMD("PRE"))
DO @(AUMD("PRE"))
+11 IF $DATA(AUME)
QUIT
+12 ; SEARCH
+13 IF $DATA(AUMAIEN)
SET AUMI=AUMAIEN
+14 IF 'AUMI&$DATA(AUMD("SEA"))
SET AUMI=$$SEARCH(AUMD("SEA"))
+15 ; INACTIVATE
+16 IF INA
IF $DATA(AUMD("INA"))
DO INACT
+17 ; NEW
+18 IF 'INA
IF 'AUMI
IF $DATA(AUMD("NEW"))
DO NEW
+19 IF 'AUMI
QUIT
+20 ; UPDATE
+21 IF 'INA
IF $DATA(AUMD("UPD"))
DO UPDATE
+22 ; WP
+23 IF $DATA(AUMD("WP"))
DO WP
+24 ; POST-UPDATE
+25 IF $DATA(AUMD("POS"))
DO @(AUMD("POS"))
QUIT
+26 ; DISPLAY
+27 IF $DATA(AUMD("DSP"))
DO DISP
QUIT
+28 DO RSLT(AUMT_": "_L)
+29 QUIT
SEARCH(AUMD) ; EP - GENERIC SEARCH DRIVER - PICKS HIGHEST IEN IF MULTIPLE RESULTS FOUND
+1 NEW F1,F2,F3,CNT,CNT2,AUMR,AUMI
+2 SET F1=$PIECE(AUMD,U,1)
SET F2=$PIECE(AUMD,U,2)
SET AUMI=""
+3 FOR CNT=1:1:$LENGTH(F2,";")
IF AUMI]""
QUIT
Begin DoDot:1
+4 SET F3=$PIECE(F2,";",CNT)
+5 IF '$DATA(@$PIECE(F3,"|",1))
DO ERR("SYSTEM ERROR - Unassigned local variable: "_$PIECE(F3,"|",1))
QUIT
+6 DO FIND^DIC(F1,"","@;.01","PX",@$PIECE(F3,"|",1),,$PIECE(F3,"|",2),,,"AUMR")
+7 SET CNT2=$PIECE($GET(AUMR("DILIST",0)),U,1)
+8 SET AUMI=$SELECT(CNT2=1:$PIECE($GET(AUMR("DILIST",1,0)),U,1),CNT2>1:$PIECE($GET(AUMR("DILIST",$PIECE($GET(AUMR("DILIST",0)),U,1),0)),U,1),1:"")
End DoDot:1
+9 QUIT AUMI
INACT ; GENERIC INACTIVATE DRIVER
+1 NEW FDA,ERR,F1,F2,F3,CNT,AUMR
+2 IF 'AUMI
SET AUMM=AUMA_" :"
DO ERR("Entry not found to INACTIVATE (ok)")
QUIT
+3 ; CUSTOM INACTIVATE CHECK
+4 IF AUMD("INA")'["|"
DO @(AUMD("INA"))
QUIT
+5 SET F1=$PIECE(AUMD("INA"),U,1)
SET F2=$PIECE(AUMD("INA"),U,2)
SET AUMR=""
+6 FOR CNT=1:1:$LENGTH(F2,";")
Begin DoDot:1
+7 SET F3=$PIECE(F2,";",CNT)
+8 IF '$DATA(@$PIECE(F3,"|",2))
DO ERR("SYSTEM ERROR - Unassigned local variable: "_$PIECE(F3,"|",2))
QUIT
+9 IF (@$PIECE(F3,"|",2))']""
QUIT
+10 IF ($$GET1^DID(F1,$PIECE(F3,"|",1),"","LABEL")']"")
QUIT
+11 SET FDA(F1,AUMI_",",$PIECE(F3,"|",1))=@$PIECE(F3,"|",2)
+12 SET AUMR=AUMR_$PIECE(F3,"|",1)_"|"_$TRANSLATE($$GET1^DIQ(F1,AUMI,$PIECE(F3,"|",1),"I"),U,";;")_"|"_$PIECE(F3,"|",2)_U
End DoDot:1
+13 DO UPDATE^DIE($SELECT($LENGTH($PIECE(AUMD("INA"),U,3))<1:"E",1:""),"FDA",,"ERR")
+14 IF $DATA(ERR)
DO ERR("SYSTEM ERROR - Inactivate failed")
QUIT
+15 IF AUMM']""
Begin DoDot:1
+16 ;I AUMA="DEL" S AUMM=AUMA_" :" Q ; IHS/OIT/NKD AUM*14.0*2 - MODIFIED PROCESSING FOR DEL TAG
+17 FOR CNT=1:1:$LENGTH(AUMR,U)
IF $PIECE(AUMR,U,CNT)']""
QUIT
Begin DoDot:2
+18 IF $$GET1^DIQ(F1,AUMI,$PIECE($PIECE(AUMR,U,CNT),"|",1),"I")=$TRANSLATE($PIECE($PIECE(AUMR,U,CNT),"|",2),";;",U)
QUIT
+19 IF $PIECE($PIECE(AUMR,U,CNT),"|",1)=".28"
QUIT
+20 SET AUML=AUML_$$GET1^DID(F1,$PIECE($PIECE(AUMR,U,CNT),"|",1),"","LABEL")_"|"_$PIECE($PIECE(AUMR,U,CNT),"|",2)_"|"_@$PIECE($PIECE(AUMR,U,CNT),"|",3)_U
+21 SET AUMM="INA :"
+22 ; IHS/OIT/NKD AUM*14.0*2 - MODIFIED PROCESSING FOR DEL TAG
IF AUMA="DEL"
SET AUMM="DEL :"
End DoDot:2
End DoDot:1
+23 QUIT
NEW ; GENERIC NEW ENTRY DRIVER
+1 NEW FDA,NEWIEN,ERR,F1,F2,F3,CNT
+2 SET AUMM="NEW :"
+3 ; CUSTOM NEW ENTRY CHECK
+4 IF AUMD("NEW")'["|"
DO @(AUMD("NEW"))
QUIT
+5 SET F1=$PIECE(AUMD("NEW"),U,1)
SET F2=$PIECE(AUMD("NEW"),U,2)
+6 FOR CNT=1:1:$LENGTH(F2,";")
Begin DoDot:1
+7 SET F3=$PIECE(F2,";",CNT)
+8 IF '$DATA(@$PIECE(F3,"|",2))
DO ERR("SYSTEM ERROR - Unassigned local variable: "_$PIECE(F3,"|",2))
QUIT
+9 IF (@$PIECE(F3,"|",2))']""
QUIT
+10 IF ($$GET1^DID(F1,$PIECE(F3,"|",1),"","LABEL")']"")
QUIT
+11 SET FDA(F1,"+1,",$PIECE(F3,"|",1))=@$PIECE(F3,"|",2)
End DoDot:1
+12 DO UPDATE^DIE($SELECT($LENGTH($PIECE(AUMD("NEW"),U,3))<1:"E",1:""),"FDA","NEWIEN","ERR")
+13 IF $DATA(ERR)
DO ERR("SYSTEM ERROR - New entry failed")
QUIT
+14 SET AUMI=NEWIEN(1)
+15 QUIT
UPDATE ; GENERIC UPDATE DRIVER
+1 NEW FDA,ERR,F1,F2,F3,CNT,AUMR
+2 SET F1=$PIECE(AUMD("UPD"),U,1)
SET F2=$PIECE(AUMD("UPD"),U,2)
SET AUMR=""
+3 FOR CNT=1:1:$LENGTH(F2,";")
Begin DoDot:1
+4 SET F3=$PIECE(F2,";",CNT)
+5 IF '$DATA(@$PIECE(F3,"|",2))
DO ERR("SYSTEM ERROR - Unassigned local variable: "_$PIECE(F3,"|",2))
QUIT
+6 IF (@$PIECE(F3,"|",2))']""
QUIT
+7 IF ($$GET1^DID(F1,$PIECE(F3,"|",1),"","LABEL")']"")
QUIT
+8 SET FDA(F1,AUMI_",",$PIECE(F3,"|",1))=@$PIECE(F3,"|",2)
+9 SET AUMR=AUMR_$PIECE(F3,"|",1)_"|"_$TRANSLATE($$GET1^DIQ(F1,AUMI,$PIECE(F3,"|",1),"I"),U,";;")_"|"_$PIECE(F3,"|",2)_U
End DoDot:1
+10 DO UPDATE^DIE($SELECT($LENGTH($PIECE(AUMD("UPD"),U,3))<1:"E",1:""),"FDA",,"ERR")
+11 IF $DATA(ERR)
DO ERR("SYSTEM ERROR - Update failed")
QUIT
+12 IF AUMM']""
Begin DoDot:1
+13 ;I AUMA=""ADD"" S AUMM=AUMA_"" :"" Q ; IHS/OIT/NKD AUM*14.0*2 - MODIFIED PROCESSING FOR ADD TAG
+14 FOR CNT=1:1:$LENGTH(AUMR,U)
IF $PIECE(AUMR,U,CNT)']""
QUIT
Begin DoDot:2
+15 IF $$GET1^DIQ(F1,AUMI,$PIECE($PIECE(AUMR,U,CNT),"|",1),"I")=$TRANSLATE($PIECE($PIECE(AUMR,U,CNT),"|",2),";;",U)
QUIT
+16 IF $PIECE($PIECE(AUMR,U,CNT),"|",1)=".28"
QUIT
+17 SET AUML=AUML_$$GET1^DID(F1,$PIECE($PIECE(AUMR,U,CNT),"|",1),"","LABEL")_"|"_$PIECE($PIECE(AUMR,U,CNT),"|",2)_"|"_@$PIECE($PIECE(AUMR,U,CNT),"|",3)_U
+18 SET AUMM="MOD :"
+19 ; IHS/OIT/NKD AUM*14.0*2 - MODIFIED PROCESSING FOR ADD TAG
IF AUMA="ADD"
SET AUMM="ADD :"
End DoDot:2
End DoDot:1
+20 QUIT
WP ; GENERIC WORD-PROCESSING DRIVER
+1 NEW FDA,ERR,F1,F2,F3,CNT
+2 NEW AUMWP1,AUMWP2
+3 SET F1=$PIECE(AUMD("WP"),U,1)
SET F2=$PIECE(AUMD("WP"),U,2)
+4 FOR CNT=1:1:$LENGTH(F2,";")
Begin DoDot:1
+5 SET F3=$PIECE(F2,";",CNT)
+6 IF '$DATA(@$PIECE(F3,"|",2))
DO ERR("SYSTEM ERROR - Unassigned local variable: "_$PIECE(F3,"|",2))
QUIT
+7 DO TEXT(.@($PIECE(F3,"|",2)))
+8 SET AUMWP1=$$GET1^DIQ(F1,AUMI_",",$PIECE(F3,"|",1),,"AUMWP1")
+9 DO WP^DIE(F1,AUMI_",",$PIECE(F3,"|",1),,$PIECE(F3,"|",2))
+10 SET AUMWP2=$$GET1^DIQ(F1,AUMI_",",$PIECE(F3,"|",1),,"AUMWP2")
+11 IF $$WPCHK(.AUMWP1,.AUMWP2)
SET AUML=AUML_$$GET1^DID(F1,$PIECE(F3,"|",1),"","LABEL")_U
SET AUMM=$SELECT(AUMM]"":AUMM,1:"MOD :")
End DoDot:1
+12 QUIT
DISP ; EP - GENERIC DISPLAY DRIVER
+1 NEW F1,F2,F3,CNT,AUMS,AUMH
+2 IF AUMP
QUIT
+3 IF $DATA(AUMD("DSP"))
Begin DoDot:1
+4 SET AUMS=""
+5 SET INAD=$SELECT(INA:"I",1:"")
+6 FOR CNT=1:1:$LENGTH(AUMD("DSP"),";")
Begin DoDot:2
+7 SET F1=$PIECE($PIECE(AUMD("DSP"),";",CNT),"|",1)
SET F2=$PIECE($PIECE(AUMD("DSP"),";",CNT),"|",2)
SET F3=$PIECE($PIECE(AUMD("DSP"),";",CNT),"|",3)
+8 IF F3]""
SET AUMS=AUMS_$JUSTIFY("",F3-$LENGTH(AUMS))
+9 SET AUMS=AUMS_$EXTRACT(@F1,1,F2)_$JUSTIFY("",F2+1-$LENGTH($EXTRACT(@F1,1,F2)))
End DoDot:2
+10 ; CHECK IF TABLE HEADER NEEDS TO BE DISPLAYED
+11 IF $DATA(AUMD("HDR"))
Begin DoDot:2
+12 SET F1=$PIECE(AUMD("HDR"),U,1)
+13 IF $PIECE(HDR,U,$LENGTH(HDR,U)-1)=@$PIECE(F1,";",1)
QUIT
+14 DO RSLT($$REPEAT^XLFSTR("-",20))
+15 SET AUMH=""
+16 DO RSLT(AUMH)
+17 SET AUMH=$GET(^TMP("AUM",$JOB,"COUNT",@$PIECE(F1,";",1)))_" "_$PIECE(F1,";",2)
+18 DO RSLT(AUMH)
+19 SET AUMH=""
+20 FOR CNT=1:1:$LENGTH($PIECE(AUMD("HDR"),U,2),";")
Begin DoDot:3
+21 SET F2=$PIECE($PIECE($PIECE(AUMD("HDR"),U,2),";",CNT),"|",1)
SET F3=$PIECE($PIECE($PIECE(AUMD("HDR"),U,2),";",CNT),"|",2)
+22 SET AUMH=AUMH_$JUSTIFY("",F3-$LENGTH(AUMH))_F2
End DoDot:3
+23 DO RSLT(AUMH)
+24 DO RSLT($TRANSLATE(AUMH,"ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890-",$$REPEAT^XLFSTR("=",37)))
+25 SET HDR=HDR_@$PIECE(F1,";",1)_U
End DoDot:2
+26 IF '$GET(AUMQ)
DO RSLT(AUMS)
DO TAGCNT
+27 IF AUMM]""
IF (($GET(AUMQ)=1)!(AUMM["ERR"))
DO RSLT(AUMS)
+28 IF $GET(AUMQ)=1
DO TAGCNT
+29 SET AUMP=1
+30 ;I $D(AUMDEBUG),AUMM'["ERR",AUMM'["NEW",AUMM'["ADD" D ; IHS/OIT/NKD AUM*14.0*2 - DEBUG TO INCLUDE ADD
+31 IF $DATA(AUMDEBUG)
IF AUMM'["ERR"
IF AUMM'["NEW"
Begin DoDot:2
+32 IF AUML']""
QUIT
+33 FOR CNT=1:1:$LENGTH(AUML,U)
IF $PIECE(AUML,U,CNT)]""
DO RSLT($JUSTIFY("",4)_$PIECE(AUML,U,CNT))
End DoDot:2
End DoDot:1
+34 QUIT
ERR(%) ; EP - ERROR MESSAGES
+1 IF 'INA
SET AUME=""
SET AUMM="ERR :"
+2 DO DISP
DO RSLT($JUSTIFY("",2)_%)
+3 QUIT
RSLT(%) ; EP - ISSUE MESSAGES DURING INSTALL
+1 DO MES^XPDUTL(%)
+2 QUIT
+3 ;
CLEAN(X) ; EP - STRING CLEANING UTILITY
+1 NEW CNT,AUMS
+2 SET AUMS=X
+3 SET CNT=0
FOR
SET CNT=$FIND(X," -")
IF 'CNT
QUIT
SET $EXTRACT(X,CNT-2,CNT-1)="-"
+4 SET CNT=0
FOR
SET CNT=$FIND(X,"- ")
IF 'CNT
QUIT
SET $EXTRACT(X,CNT-2,CNT-1)="-"
+5 SET CNT=0
FOR
SET CNT=$FIND(X," ")
IF 'CNT
QUIT
SET $EXTRACT(X,CNT-2,CNT-1)=" "
+6 IF $EXTRACT(X,1)=" "
SET X=$EXTRACT(X,2,$LENGTH(X))
+7 IF $EXTRACT(X,$LENGTH(X))=" "
SET X=$EXTRACT(X,1,$LENGTH(X)-1)
+8 QUIT X
TEXT(X) ; EP - STRING TO WP ARRAY USING '|' AS A DELIMITER
+1 NEW AUMS,I,J
+2 SET AUMS=X
SET I=1
SET J=1
+3 KILL X
+4 FOR I=1:1:$LENGTH(AUMS,"|")
Begin DoDot:1
+5 IF $LENGTH($PIECE(AUMS,"|",I))=0
QUIT
+6 ; IHS/OIT/NKD AUM*16.0*3 - START NEW CODE - NICE BREAKING OTHERWISE 80 CHARS
+7 IF $LENGTH($PIECE(AUMS,"|",I))>80
Begin DoDot:2
+8 NEW STR
SET STR=$PIECE(AUMS,"|",I)
FOR
IF '$LENGTH(STR)
QUIT
Begin DoDot:3
+9 NEW BRK,TRY
SET BRK=0
SET TRY=$LENGTH(STR)
Begin DoDot:4
+10 IF TRY<81
SET BRK=TRY
QUIT
+11 FOR TRY=80:-1:2
Begin DoDot:5
+12 IF $EXTRACT(STR,TRY+1)=" "
SET $EXTRACT(STR,TRY+1)=""
SET BRK=TRY
QUIT
+13 IF "&_+-*/<=>}])|:;,.?!"[$EXTRACT(STR,TRY)
IF $EXTRACT(STR,TRY+1)=" "
SET BRK=TRY
QUIT
End DoDot:5
IF BRK
QUIT
+14 IF 'BRK
SET BRK=80
End DoDot:4
+15 SET X(J)=$EXTRACT(STR,1,BRK)
SET J=J+1
SET $EXTRACT(STR,1,BRK)=""
End DoDot:3
End DoDot:2
QUIT
+16 ; IHS/OIT/NKD AUM*16.0*3 - END NEW CODE
+17 SET X(J)=$PIECE(AUMS,"|",I)
SET J=J+1
End DoDot:1
+18 QUIT
WPCHK(AUMWP1,AUMWP2) ; COMPARE WP ARRAYS AND RETURN 1 IF NOT EQUAL
+1 NEW CNT,AUMFR,AUMTO,AUMRES
+2 SET AUMRES=0
+3 SET CNT=0
SET AUMFR=0
FOR
SET CNT=$ORDER(AUMWP1(CNT))
IF 'CNT
QUIT
SET AUMFR=AUMFR+1
+4 SET CNT=0
SET AUMTO=0
FOR
SET CNT=$ORDER(AUMWP2(CNT))
IF 'CNT
QUIT
SET AUMTO=AUMTO+1
+5 IF AUMFR'=AUMTO
SET AUMRES=1
+6 IF '$TEST
FOR CNT=1:1:AUMTO
IF $$CLEAN($GET(AUMWP1(CNT)))'=$$CLEAN($GET(AUMWP2(CNT)))
SET AUMRES=1
+7 QUIT AUMRES
TAGCNT ; UPDATE LOCAL MODIFICATION COUNT AND DISPLAY IF TOTAL REACHED
+1 NEW AUMLA,AUMCNT,AUMCNT2,AUMCNT3
+2 SET AUMLA=$PIECE(AUMM," ")
+3 SET AUMLA=$SELECT(AUMLA="MOD":"MODIFIED",AUMLA="INA":"INACTIVE",AUMLA="DEL":"DELETE",AUMLA="ERR":"ERROR",1:AUMLA)
+4 SET AUMLA=$SELECT(AUMLA]"":AUMLA,1:"UNMODIFIED")
+5 SET ^TMP("AUM",$JOB,"COUNT",AUMT,AUMLA)=$GET(^TMP("AUM",$JOB,"COUNT",AUMT,AUMLA))+1
+6 SET AUMCNT=$GET(^TMP("AUM",$JOB,"COUNT",AUMT))
SET AUMCNT2=0
+7 SET AUMCNT3=""
FOR
SET AUMCNT3=$ORDER(^TMP("AUM",$JOB,"COUNT",AUMT,AUMCNT3))
IF AUMCNT3']""
QUIT
SET AUMCNT2=AUMCNT2+$GET(^TMP("AUM",$JOB,"COUNT",AUMT,AUMCNT3))
+8 IF AUMCNT'=AUMCNT2
QUIT
+9 DO RSLT("")
+10 FOR AUMCNT3="NEW","ADD","MODIFIED","INACTIVE","DELETE","ERROR","UNMODIFIED"
Begin DoDot:1
+11 IF ($GET(^TMP("AUM",$JOB,"COUNT",AUMT,AUMCNT3))'>0)
QUIT
+12 DO RSLT(AUMCNT3_$$REPEAT^XLFSTR(".",11-$LENGTH(AUMCNT3))_$GET(^TMP("AUM",$JOB,"COUNT",AUMT,AUMCNT3)))
End DoDot:1
+13 DO RSLT("TOTAL......"_AUMCNT2)
+14 QUIT
