GMPLSLI1 ;ISP/TC - Problem Selection List Import Utility ;04/13/2020
;;2.0;Problem List;**49,55**;Aug 25, 1994;Build 1
;
; External References:
; ICR 2053 FILE/UPDATE^DIE
; ICR 2320 $$PWD/$$LIST/$$FTG^%ZISH
; ICR 2607 BROWSE^DDBR
; ICR 5553 $$GETURL^XTHC10
; ICR 10103 $$DT^XLFDT
; ICR 10104 $$LJ/$$LOW/$$REPEAT^XLFSTR
; ICR 10026 ^DIR
; ICR 10142 EN^DDIOL
;
IMP ; Import categories & diagnoses into a selection list
N DIR,Y,GMPLLDOK,GMPLOPT
;Present the menu of import choices.
S DIR(0)="S^HF:CSV host file;"
S DIR(0)=DIR(0)_"WEB:CSV file from a web site"
S DIR("A")="Select the import method"
D ^DIR
S GMPLOPT=Y
I GMPLOPT="HF" D
. S GMPLLDOK=$$LOADHF("GMPLSLIM")
. I GMPLLDOK D IMPCSV("GMPLSLIM")
I GMPLOPT="WEB" D
. S GMPLLDOK=$$LOADWEB("GMPLSLIM")
. I GMPLLDOK D IMPCSV("GMPLSLIM")
Q
;============================================
IMPCSV(GMPLNODE) ;Import comma separated data into the Problem Selection List & Category files
; Flag indicators: '#' - Add/edit, '@' - Delete
;
; The expected format is:
; #/@, Selection List Name, List Class, Category Class
; #/@, Category Sequence, Category Name, Subheader
; #/@, Problem Sequence, Display Text, ICD code, SCT code, SCT designation
;
I '$D(^TMP($J,GMPLNODE)) Q 0
N GMPLI,GMPLABRT,GMPLTMP,GMPLFLAG,GMPLIMPT,GMPLRNDE
S (GMPLI,GMPLABRT)=0,GMPLIMPT=1,GMPLRNDE="GMPLIRPT"
D EN^DDIOL("Starting the import process ... ","","!!")
W !
F S GMPLI=$O(^TMP($J,GMPLNODE,GMPLI)) Q:GMPLI="" D
. S GMPLTMP=^TMP($J,GMPLNODE,GMPLI,1)
. I '$$ISCSV^GMPLSLI2(GMPLTMP) Q
. S GMPLFLAG=$P(GMPLTMP,",",1)
. ; Retrieve/validate selection list name & class
. I GMPLI=1 D
. . S GMPLABRT=$$VALSLST(GMPLTMP,GMPLFLAG,GMPLIMPT,GMPLRNDE,GMPLABRT)
. ; Retrieve/validate category information
. I GMPLFLAG'>0,(GMPLI>1),('$L($$STRIP^XLFSTR($P(GMPLTMP,",",5),""_$C(13)_""))) D
. . S GMPLABRT=$$VALCAT(GMPLTMP,GMPLFLAG,GMPLIMPT,GMPLRNDE,GMPLABRT)
. ; Check for valid Problem sequence numbers
. I GMPLI>2,($L($$STRIP^XLFSTR($P(GMPLTMP,",",5),""_$C(13)_""))) D
. . I '+$$VSEQ^GMPLINTR(GMPLFLAG,"Problem") S GMPLABRT=1
. ; Retrieve/validate category problems
. I GMPLFLAG>0 D
. . S GMPLABRT=$$VALCPROB(GMPLTMP,GMPLRNDE,GMPLABRT)
I GMPLABRT D EN^DDIOL("Import process aborted due to validation errors.","","!!") G IMPCSVQT
D MSGHNDL(GMPLNODE,GMPLRNDE)
K ^TMP($J,GMPLNODE),^TMP($J,GMPLRNDE)
IMPCSVQT W ! D PAUSE^GMPLX
Q
;============================================
LOADHF(GMPLNOUT) ;Load the CSV host file into ^TMP.
;The name of the host file should have a ".CSV" extension.
N GMPLFILE,GMPLGBL,GMPLLHF,GMPLPATH,GMPLTMP
S GMPLTMP=$$GETEHF^GMPLUTL4("CSV")
I GMPLTMP="" Q 0
S GMPLPATH=$P(GMPLTMP,U,1),GMPLFILE=$P(GMPLTMP,U,2)
;Load the host file into ^TMP.
K ^TMP($J,GMPLNOUT),^TMP($J,"GMPLHCSV")
S GMPLGBL="^TMP($J,""GMPLHCSV"",1)"
S GMPLGBL=$NA(@GMPLGBL)
;Load the file contents into ^TMP.
S GMPLLHF=$$FTG^%ZISH(GMPLPATH,GMPLFILE,GMPLGBL,3)
I GMPLLHF=0 D EN^DDIOL("The host file load failed") H 2 K ^TMP($J,"GMPLHCSV") Q 0
D RBLCKHF^GMPLSLI2("GMPLHCSV",GMPLNOUT)
K ^TMP($J,"GMPLHCSV")
Q 1
;============================================
LOADWEB(GMPLNOUT) ;Load the CSV file from a web site into ^TMP
N DIR,GMPLHDR,GMPLRSLT,GMPLTXT,GMPLURL,Y
S DIR(0)="F^10:245"
S DIR("A")="Input the URL for the CSV file"
D ^DIR
I (Y="")!(Y=U) Q 0
S GMPLURL=Y
S Y=$$LOW^XLFSTR(Y)
;Load the file contents into ^TMP.
K ^TMP($J,GMPLNOUT),^TMP($J,"GMPLWCSV")
;DBIA #5553
S GMPLRSLT=$$GETURL^XTHC10(GMPLURL,10,"^TMP($J,""GMPLWCSV"")",.GMPLHDR)
I $P(GMPLRSLT,U,1)'=200 D Q 0
. S GMPLTXT="Could not load the csv file: "
. S GMPLTXT=GMPLTXT_"Error "_$P(GMPLRSLT,U,1)_" "_$P(GMPLRSLT,U,2)
. D EN^DDIOL(.GMPLTXT) H 2
. K ^TMP($J,"GMPLWCSV")
D RBLCKWEB^GMPLSLI2("GMPLWCSV",GMPLNOUT)
K ^TMP($J,"GMPLWCSV")
Q 1
;============================================
MSGHNDL(GMPLNODE,GMPLRNDE) ; Message prompt and handling
N GMPLANS,GMPLSVOK,GMPLPUOK,GMPLMSG
S GMPLANS=$$ASKYN^GMPLUTL4("Y","Do you want to review the problem selection list contents")
I GMPLANS D BROWSE^DDBR("^TMP($J,"""_GMPLRNDE_""")","NR","Selection List Contents To Be Imported")
S GMPLANS=$$ASKYN^GMPLUTL4("N","Do you want to save the imported list contents")
I GMPLANS D
. S GMPLSVOK=$$UPDTCNT(GMPLNODE)
. I GMPLSVOK D
. . S GMPLPUOK=$$POSTUPDT(GMPLNODE)
. . I GMPLPUOK D EN^DDIOL("Import process completed successfully.","","!!")
. . E D
. . . S GMPLMSG(1)="Import process partially failed due to the above errors."
. . . S GMPLMSG(1,"F")="!!"
. . . S GMPLMSG(2)="Some content may/may not have been saved completely."
. . . S GMPLMSG(3)="Verify newly imported content w/the import file, correct any errors, & re-import"
. . . D EN^DDIOL(.GMPLMSG)
E D EN^DDIOL("Import process aborted.","","!!")
Q
;============================================
POSTUPDT(GMPLNODE) ; Save the list categories & diagnoses
N GMPLI,GMPLREC,GMPLFLAG,GMPLLNME,GMPLCCLS
N GMPLCLS,GMPLCNME,GMPLADDC,GMPLOK
S (GMPLI,GMPLADDC)=0,GMPLOK=1
F S GMPLI=$O(^TMP($J,GMPLNODE,GMPLI)) Q:GMPLI="" D
. S GMPLREC=^TMP($J,GMPLNODE,GMPLI,1)
. I GMPLREC="" Q
. S GMPLFLAG=$P(GMPLREC,",",1)
. I GMPLI=1 D
. . S GMPLLNME=$P(GMPLREC,",",2),GMPLCCLS=$$UP^XLFSTR($P(GMPLREC,",",4))
. . S GMPLCLS=$S(GMPLCCLS="NATIONAL":"N",GMPLCCLS="LOCAL":"L",GMPLCCLS="VISN":"V",1:"")
. ; Retrieve & save category info
. I GMPLFLAG'>0,(GMPLI>1) D Q
. . S GMPLCNME=$$UP^XLFSTR($P(GMPLREC,",",3)),GMPLADDC=$S(GMPLFLAG="#":1,1:0)
. . S GMPLOK=$$SVC12511(GMPLREC,GMPLFLAG,GMPLCLS,GMPLCCLS,GMPLOK)
. . I GMPLOK S GMPLOK=$$SVC12501(GMPLREC,GMPLFLAG,GMPLLNME,GMPLOK)
. ; Retrieve & save category problems
. I GMPLADDC,(GMPLFLAG>0) D
. . S GMPLOK=$$SVPROB(GMPLREC,GMPLCNME,GMPLOK)
I $D(^GMPL(125.11,0)) S $P(^GMPL(125.11,0),U,3)=0
K ^GMPLCIEN(1),^GMPLINRT(1)
Q GMPLOK
;============================================
SVC12501(GMPLREC,GMPLFLAG,GMPLLNME,GMPLOK) ; Save category info into subfile 125.01
N GMPLLIEN,GMPLDA,GMPLKFDA,GMPLFDA,GMPLIENS
N GMPLCSEQ,GMPLCNME,GMPLSHDR,GMPLMSG,GMPLTXT
S GMPLCSEQ=$P(GMPLREC,",",2),GMPLCNME=$$UP^XLFSTR($P(GMPLREC,",",3))
S GMPLSHDR=$P(GMPLREC,",",4)
S GMPLLIEN=+$$FIND1^DIC(125,"","K",GMPLLNME,"","","GMPLMSG")
I GMPLFLAG="@",(GMPLLIEN>0) D G SVCQT
. S GMPLDA=+$$FIND1^DIC(125.01,","_GMPLLIEN_",","K",GMPLCNME,"","","GMPLMSG")
. I GMPLDA>0 D
. . S GMPLKFDA(125.01,""_GMPLDA_","_GMPLLIEN_",",.01)="@"
. . D FILE^DIE("K","GMPLKFDA","GMPLMSG")
I GMPLFLAG="@" G SVCQT
S GMPLIENS=$S(GMPLLIEN>0:"+2,"_GMPLLIEN_",",1:"+2,+1,")
S GMPLFDA(125.01,GMPLIENS,.01)=GMPLCNME
S GMPLFDA(125.01,GMPLIENS,.02)=GMPLCSEQ
S GMPLFDA(125.01,GMPLIENS,.03)=GMPLSHDR
S GMPLFDA(125.01,GMPLIENS,.04)="YES"
D UPDATE^DIE("E","GMPLFDA","","GMPLMSG")
SVCQT I $D(GMPLMSG) D
. S GMPLTXT(1)="Unable to "_$S(GMPLFLAG="@":"delete",1:"store")
. S GMPLTXT(1)=GMPLTXT(1)_" category "_GMPLCNME_" under list "_GMPLLNME
. S GMPLTXT(2)="Error "_GMPLMSG("DIERR",1)_": "_GMPLMSG("DIERR",1,"TEXT",1)
. D EN^DDIOL(.GMPLTXT) S GMPLOK=0
Q GMPLOK
;============================================
SVC12511(GMPLREC,GMPLFLAG,GMPLCLS,GMPLCCLS,GMPLOK) ; Save category info into file 125.11
N GMPLCSEQ,GMPLCNME,GMPLSHDR,GMPLKFDA
N GMPLMSG,GMPLFDA,GMPLTXT
K ^GMPLCIEN(1),^GMPLINRT(1)
S GMPLCSEQ=$P(GMPLREC,",",2),GMPLCNME=$$UP^XLFSTR($P(GMPLREC,",",3))
S GMPLSHDR=$P(GMPLREC,",",4)
;If there are any existing entries for this category,
;delete them prior to storing the new set.
S ^GMPLCIEN(1)=+$$FIND1^DIC(125.11,"","K",GMPLCNME,"","","GMPLMSG")
I $G(^GMPLCIEN(1))>0 D
. S ^GMPLINRT(1)=^GMPLCIEN(1)
. S GMPLKFDA(125.11,""_$G(^GMPLCIEN(1))_",",.01)="@"
. D FILE^DIE("K","GMPLKFDA","GMPLMSG")
E S ^GMPLINRT(1)=""
I GMPLFLAG="@" G SVCQT1
S GMPLFDA(125.11,"+1,",.01)=GMPLCNME
S GMPLFDA(125.11,"+1,",.02)=$$DT^XLFDT
S GMPLFDA(125.11,"+1,",.03)=GMPLCLS
D UPDATE^DIE("","GMPLFDA","^GMPLINRT","GMPLMSG")
SVCQT1 I $D(GMPLMSG) D Q
. S GMPLTXT(1)="Unable to "_$S(GMPLFLAG="@":"delete",1:"store")
. S GMPLTXT(1)=GMPLTXT(1)_" category "_GMPLCNME_" and class "_GMPLCCLS_" in file #125.11."
. S GMPLTXT(2)="Error "_GMPLMSG("DIERR",1)_": "_GMPLMSG("DIERR",1,"TEXT",1)
. D EN^DDIOL(.GMPLTXT) S GMPLOK=0
Q GMPLOK
;============================================
SVPROB(GMPLREC,GMPLCNME,GMPLOK) ; Save category problems into subfile 125.11
N GMPLDTXT,GMPLPSEQ,GMPLICD,GMPLSCTC,GMPLSCTD
N GMPLLTRM,GMPLMSG,GMPLTXT,GMPLISTR,GMPLFDA
I $L(GMPLREC,",")>5 D
. N GMPLTPC,GMPLDPC,GMPLK
. S GMPLTPC=$L(GMPLREC,","),GMPLDPC=GMPLTPC-4,GMPLDTXT=""
. F GMPLK=2:1:(GMPLDPC+1) S GMPLDTXT=GMPLDTXT_$S(GMPLK>2:",",1:"")_$P(GMPLREC,",",GMPLK)
. S GMPLPSEQ=$$STRIP^XLFSTR($P(GMPLREC,",",1)," "),GMPLDTXT=$$STRIP^XLFSTR(GMPLDTXT,"""")
. S GMPLICD=$$STRIP^XLFSTR($P(GMPLREC,",",(GMPLDPC+2))," ")
. S GMPLSCTC=$$STRIP^XLFSTR($$STRIP^XLFSTR($P(GMPLREC,",",(GMPLDPC+3)),"C")," ")
. S GMPLSCTD=$$STRIP^XLFSTR($$STRIP^XLFSTR($P($P(GMPLREC,",",(GMPLDPC+4)),""_$C(13)_""),"D")," ")
E D
. S GMPLPSEQ=$$STRIP^XLFSTR($P(GMPLREC,",",1)," "),GMPLDTXT=$$STRIP^XLFSTR($P(GMPLREC,",",2),"""")
. S GMPLICD=$$STRIP^XLFSTR($P(GMPLREC,",",3)," "),GMPLSCTC=$$STRIP^XLFSTR($$STRIP^XLFSTR($P(GMPLREC,",",4),"C")," ")
. S GMPLSCTD=$$STRIP^XLFSTR($$STRIP^XLFSTR($P($P(GMPLREC,",",5),""_$C(13)_""),"D")," ")
S GMPLLTRM=$$GETEXIEN^GMPLX(GMPLSCTC,GMPLSCTD)
I GMPLDTXT["sct" S GMPLDTXT=$P(GMPLDTXT,"(")_"("_$$UP^XLFSTR($P($P(GMPLDTXT,"(",2)," "))_" "_$P($P(GMPLDTXT,"(",2)," ",2)
I GMPLDTXT'["SCT" S GMPLDTXT=GMPLDTXT_" (SCT "_GMPLSCTC_")"
I +GMPLLTRM<0 D Q
. S GMPLTXT(1)="Unable to save "_GMPLDTXT
. S GMPLTXT(2)="Error: "_$P(GMPLLTRM,U,2)
. D EN^DDIOL(.GMPLTXT) S GMPLOK=0
S GMPLISTR=$S(^GMPLCIEN(1)>0:"+2,"_^GMPLCIEN(1)_",",1:"+2,"_^GMPLINRT(1)_",")
S GMPLFDA(125.111,GMPLISTR,.01)=GMPLLTRM
S GMPLFDA(125.111,GMPLISTR,.02)=GMPLPSEQ
S GMPLFDA(125.111,GMPLISTR,.03)=GMPLDTXT
S GMPLFDA(125.111,GMPLISTR,.04)=GMPLICD
S GMPLFDA(125.111,GMPLISTR,.05)=GMPLSCTC
S GMPLFDA(125.111,GMPLISTR,.06)=GMPLSCTD
D UPDATE^DIE("","GMPLFDA","","GMPLMSG")
I $D(GMPLMSG) D
. S GMPLTXT(1)="Unable to store problem: "_GMPLDTXT_" from category "_GMPLCNME_"."
. S GMPLTXT(2)="Error "_GMPLMSG("DIERR",1)_": "_GMPLMSG("DIERR",1,"TEXT",1)
. D EN^DDIOL(.GMPLTXT) S GMPLOK=0
Q GMPLOK
;============================================
UPDTCNT(GMPLNODE) ; Save/delete the list name & class
; Flag indicators: # - Add/edit list, @ - Delete list
N GMPLLST,GMPLFDA,GMPLMSG,GMPLLNME,GMPLLCLS,GMPLCLS
N GMPLSUC,GMPLTXT,GMPLIEN,GMPLINRT,GMPLFLAG
S GMPLSUC=1
S GMPLLST=^TMP($J,GMPLNODE,1,1)
S GMPLFLAG=$P(GMPLLST,",",1)
S GMPLLNME=$$UP^XLFSTR($P(GMPLLST,",",2))
S GMPLLCLS=$$UP^XLFSTR($P(GMPLLST,",",3))
S GMPLCLS=$S(GMPLLCLS="NATIONAL":"N",GMPLLCLS="LOCAL":"L",GMPLLCLS="VISN":"V",1:"")
S GMPLIEN=+$$FIND1^DIC(125,"","K",GMPLLNME,"","","GMPLMSG")
I GMPLIEN>0 D
. S GMPLINRT(1)=GMPLIEN
. S GMPLFDA(125,""_GMPLIEN_",",.01)="@"
. D FILE^DIE("K","GMPLFDA","GMPLMSG")
I GMPLFLAG="@" G UPQT
S GMPLFDA(125,"+1,",.01)=GMPLLNME
S GMPLFDA(125,"+1,",.02)=$$DT^XLFDT
S GMPLFDA(125,"+1,",.04)=GMPLCLS
D UPDATE^DIE("","GMPLFDA","GMPLINRT","GMPLMSG")
UPQT I $D(GMPLMSG) D
. S GMPLTXT(1)="Unable to "_$S(GMPLFLAG="@":"delete",1:"store")
. S GMPLTXT(1)=GMPLTXT(1)_" list "_GMPLLNME_" and class "_GMPLLCLS_" in file #125."
. S GMPLTXT(2)="Error: "_GMPLMSG("DIERR",1,"TEXT",1)
. D EN^DDIOL(.GMPLTXT)
. S GMPLSUC=0
;Reset the 125 0 node so holes are not left.
I $D(^GMPL(125,0)) S $P(^GMPL(125,0),U,3)=0
Q GMPLSUC
;============================================
VALCAT(GMPLTMP,GMPLFLAG,GMPLIMPT,GMPLRNDE,GMPLABRT) ; Validate category info
N GMPLCSEQ,GMPLCNME,GMPLSHDR,GMPLHSTR,GMPLSQST,GMPLNL
S GMPLCSEQ=$P(GMPLTMP,",",2),GMPLCNME=$P(GMPLTMP,",",3)
S GMPLSHDR=$P(GMPLTMP,",",4),GMPLHSTR="Subheader: "_GMPLSHDR
S GMPLNL=$G(^TMP($J,GMPLRNDE))
I '+$$VFLAG^GMPLINTR(GMPLFLAG) S GMPLABRT=1
I '+$$VSEQ^GMPLINTR(GMPLCSEQ,"Category") S GMPLABRT=1
E S GMPLSQST="Category Sequence: "_GMPLCSEQ
I '+$$VNAME^GMPLINTR(GMPLCNME,GMPLIMPT,"Category") D
. D EN^DDIOL(" For category sequence #"_GMPLCSEQ_".")
. S GMPLABRT=1
I 'GMPLABRT D
. S GMPLNL=GMPLNL+1,^TMP($J,GMPLRNDE,GMPLNL)=""
. S GMPLNL=GMPLNL+1,^TMP($J,GMPLRNDE,GMPLNL)="Category Name: "_GMPLCNME_$S(GMPLFLAG="@":" ***MARKED FOR DELETION!!!***",1:"")
. S GMPLNL=GMPLNL+1,^TMP($J,GMPLRNDE,GMPLNL)=$$LJ^XLFSTR(GMPLHSTR,47)_$$LJ^XLFSTR(GMPLSQST,33)
. S GMPLNL=GMPLNL+1,^TMP($J,GMPLRNDE,GMPLNL)=""
. S GMPLNL=GMPLNL+1,^TMP($J,GMPLRNDE,GMPLNL)="Prob"_$J("SNOMED CT",10)_$J("SNOMED CT",21)
. S GMPLNL=GMPLNL+1,^TMP($J,GMPLRNDE,GMPLNL)="Seq"_$J("Concept",9)_$J("Designation",25)_$J("ICD Code",18)_$J("SNOMED CT Description",42)
. S GMPLNL=GMPLNL+1,^TMP($J,GMPLRNDE,GMPLNL)=$$REPEAT^XLFSTR("-",150)
S ^TMP($J,GMPLRNDE)=GMPLNL
Q GMPLABRT
;============================================
VALCPROB(GMPLTMP,GMPLRNDE,GMPLABRT) ; Validate category problems
N GMPLPSEQ,GMPLDTXT,GMPLICD,GMPLSCTC,GMPLSCTD,GMPLNL
S GMPLNL=$G(^TMP($J,GMPLRNDE))
I $L(GMPLTMP,",")>5 D
. N GMPLTPC,GMPLDPC,GMPLK
. S GMPLTPC=$L(GMPLTMP,","),GMPLDPC=GMPLTPC-4,GMPLDTXT=""
. F GMPLK=2:1:(GMPLDPC+1) S GMPLDTXT=GMPLDTXT_$S(GMPLK>2:",",1:"")_$P(GMPLTMP,",",GMPLK)
. S GMPLPSEQ=$$STRIP^XLFSTR($P(GMPLTMP,",",1)," "),GMPLDTXT=$$STRIP^XLFSTR(GMPLDTXT,"""")
. S GMPLICD=$$STRIP^XLFSTR($P(GMPLTMP,",",(GMPLDPC+2))," ")
. S GMPLSCTC=$$STRIP^XLFSTR($$STRIP^XLFSTR($P(GMPLTMP,",",(GMPLDPC+3)),"C")," ")
. S GMPLSCTD=$$STRIP^XLFSTR($$STRIP^XLFSTR($P($P(GMPLTMP,",",(GMPLDPC+4)),""_$C(13)_""),"D")," ")
E D
. S GMPLPSEQ=$$STRIP^XLFSTR($P(GMPLTMP,",",1)," "),GMPLDTXT=$$STRIP^XLFSTR($P(GMPLTMP,",",2),"""")
. S GMPLICD=$$STRIP^XLFSTR($P(GMPLTMP,",",3)," "),GMPLSCTC=$$STRIP^XLFSTR($$STRIP^XLFSTR($P(GMPLTMP,",",4),"C")," ")
. S GMPLSCTD=$$STRIP^XLFSTR($$STRIP^XLFSTR($P($P(GMPLTMP,",",5),""_$C(13)_""),"D")," ")
I GMPLDTXT["sct" S GMPLDTXT=$P(GMPLDTXT,"(")_"("_$$UP^XLFSTR($P($P(GMPLDTXT,"(",2)," "))_" "_$P($P(GMPLDTXT,"(",2)," ",2)
I GMPLDTXT'["SCT" S GMPLDTXT=GMPLDTXT_" (SCT "_GMPLSCTC_")"
I '+$$VICD^GMPLINTR(GMPLICD) S GMPLABRT=1
I '+$$VSCTCODE^GMPLINTR(GMPLSCTC) S GMPLABRT=1 Q GMPLABRT
I '+$$VSCTDSGN^GMPLINTR(GMPLSCTC,GMPLSCTD,$P(GMPLDTXT," (SCT")) S GMPLABRT=1
I 'GMPLABRT D
. S GMPLNL=GMPLNL+1,^TMP($J,GMPLRNDE,GMPLNL)=$$LJ^XLFSTR(GMPLPSEQ,5)_$$LJ^XLFSTR(GMPLSCTC,21)_$$LJ^XLFSTR(GMPLSCTD,21)_$$LJ^XLFSTR(GMPLICD,29)_$$LJ^XLFSTR(GMPLDTXT,80)
S ^TMP($J,GMPLRNDE)=GMPLNL
Q GMPLABRT
;============================================
VALSLST(GMPLTMP,GMPLFLAG,GMPLIMPT,GMPLRNDE,GMPLABRT) ; Validate selection list & class
N GMPLLNME,GMPLLCLS,GMPLCCLS,GMPLNL
S GMPLLNME=$P(GMPLTMP,",",2),GMPLLCLS=$P(GMPLTMP,",",3)
S GMPLCCLS=$P(GMPLTMP,",",4),GMPLNL=0
K ^TMP($J,GMPLRNDE)
I GMPLFLAG="@" S GMPLNL=GMPLNL+1,^TMP($J,GMPLRNDE,GMPLNL)="***MARKED FOR DELETION!!!***"
I '+$$VFLAG^GMPLINTR(GMPLFLAG) S GMPLABRT=1
I '+$$VNAME^GMPLINTR(GMPLLNME,GMPLIMPT,"List") S GMPLABRT=1
I '+$$VCLASS^GMPLINTR(GMPLLCLS,GMPLIMPT,"List") S GMPLABRT=1
I '+$$VCLASS^GMPLINTR(GMPLCCLS,GMPLIMPT,"Category") S GMPLABRT=1
I 'GMPLABRT D
. S GMPLNL=GMPLNL+1,^TMP($J,GMPLRNDE,GMPLNL)="Selection List Name: "_GMPLLNME
. S GMPLNL=GMPLNL+1,^TMP($J,GMPLRNDE,GMPLNL)="List Class: "_GMPLLCLS_$J("Category Class: ",34)_GMPLCCLS
S ^TMP($J,GMPLRNDE)=GMPLNL
Q GMPLABRT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLSLI1 15521 printed Jun 11, 2024@22:16:14 Page 2
GMPLSLI1 ;ISP/TC - Problem Selection List Import Utility ;04/13/2020
+1 ;;2.0;Problem List;**49,55**;Aug 25, 1994;Build 1
+2 ;
+3 ; External References:
+4 ; ICR 2053 FILE/UPDATE^DIE
+5 ; ICR 2320 $$PWD/$$LIST/$$FTG^%ZISH
+6 ; ICR 2607 BROWSE^DDBR
+7 ; ICR 5553 $$GETURL^XTHC10
+8 ; ICR 10103 $$DT^XLFDT
+9 ; ICR 10104 $$LJ/$$LOW/$$REPEAT^XLFSTR
+10 ; ICR 10026 ^DIR
+11 ; ICR 10142 EN^DDIOL
+12 ;
IMP ; Import categories & diagnoses into a selection list
+1 NEW DIR,Y,GMPLLDOK,GMPLOPT
+2 ;Present the menu of import choices.
+3 SET DIR(0)="S^HF:CSV host file;"
+4 SET DIR(0)=DIR(0)_"WEB:CSV file from a web site"
+5 SET DIR("A")="Select the import method"
+6 DO ^DIR
+7 SET GMPLOPT=Y
+8 IF GMPLOPT="HF"
Begin DoDot:1
+9 SET GMPLLDOK=$$LOADHF("GMPLSLIM")
+10 IF GMPLLDOK
DO IMPCSV("GMPLSLIM")
End DoDot:1
+11 IF GMPLOPT="WEB"
Begin DoDot:1
+12 SET GMPLLDOK=$$LOADWEB("GMPLSLIM")
+13 IF GMPLLDOK
DO IMPCSV("GMPLSLIM")
End DoDot:1
+14 QUIT
+15 ;============================================
IMPCSV(GMPLNODE) ;Import comma separated data into the Problem Selection List & Category files
+1 ; Flag indicators: '#' - Add/edit, '@' - Delete
+2 ;
+3 ; The expected format is:
+4 ; #/@, Selection List Name, List Class, Category Class
+5 ; #/@, Category Sequence, Category Name, Subheader
+6 ; #/@, Problem Sequence, Display Text, ICD code, SCT code, SCT designation
+7 ;
+8 IF '$DATA(^TMP($JOB,GMPLNODE))
QUIT 0
+9 NEW GMPLI,GMPLABRT,GMPLTMP,GMPLFLAG,GMPLIMPT,GMPLRNDE
+10 SET (GMPLI,GMPLABRT)=0
SET GMPLIMPT=1
SET GMPLRNDE="GMPLIRPT"
+11 DO EN^DDIOL("Starting the import process ... ","","!!")
+12 WRITE !
+13 FOR
SET GMPLI=$ORDER(^TMP($JOB,GMPLNODE,GMPLI))
if GMPLI=""
QUIT
Begin DoDot:1
+14 SET GMPLTMP=^TMP($JOB,GMPLNODE,GMPLI,1)
+15 IF '$$ISCSV^GMPLSLI2(GMPLTMP)
QUIT
+16 SET GMPLFLAG=$PIECE(GMPLTMP,",",1)
+17 ; Retrieve/validate selection list name & class
+18 IF GMPLI=1
Begin DoDot:2
+19 SET GMPLABRT=$$VALSLST(GMPLTMP,GMPLFLAG,GMPLIMPT,GMPLRNDE,GMPLABRT)
End DoDot:2
+20 ; Retrieve/validate category information
+21 IF GMPLFLAG'>0
IF (GMPLI>1)
IF ('$LENGTH($$STRIP^XLFSTR($PIECE(GMPLTMP,",",5),""_$CHAR(13)_"")))
Begin DoDot:2
+22 SET GMPLABRT=$$VALCAT(GMPLTMP,GMPLFLAG,GMPLIMPT,GMPLRNDE,GMPLABRT)
End DoDot:2
+23 ; Check for valid Problem sequence numbers
+24 IF GMPLI>2
IF ($LENGTH($$STRIP^XLFSTR($PIECE(GMPLTMP,",",5),""_$CHAR(13)_"")))
Begin DoDot:2
+25 IF '+$$VSEQ^GMPLINTR(GMPLFLAG,"Problem")
SET GMPLABRT=1
End DoDot:2
+26 ; Retrieve/validate category problems
+27 IF GMPLFLAG>0
Begin DoDot:2
+28 SET GMPLABRT=$$VALCPROB(GMPLTMP,GMPLRNDE,GMPLABRT)
End DoDot:2
End DoDot:1
+29 IF GMPLABRT
DO EN^DDIOL("Import process aborted due to validation errors.","","!!")
GOTO IMPCSVQT
+30 DO MSGHNDL(GMPLNODE,GMPLRNDE)
+31 KILL ^TMP($JOB,GMPLNODE),^TMP($JOB,GMPLRNDE)
IMPCSVQT WRITE !
DO PAUSE^GMPLX
+1 QUIT
+2 ;============================================
LOADHF(GMPLNOUT) ;Load the CSV host file into ^TMP.
+1 ;The name of the host file should have a ".CSV" extension.
+2 NEW GMPLFILE,GMPLGBL,GMPLLHF,GMPLPATH,GMPLTMP
+3 SET GMPLTMP=$$GETEHF^GMPLUTL4("CSV")
+4 IF GMPLTMP=""
QUIT 0
+5 SET GMPLPATH=$PIECE(GMPLTMP,U,1)
SET GMPLFILE=$PIECE(GMPLTMP,U,2)
+6 ;Load the host file into ^TMP.
+7 KILL ^TMP($JOB,GMPLNOUT),^TMP($JOB,"GMPLHCSV")
+8 SET GMPLGBL="^TMP($J,""GMPLHCSV"",1)"
+9 SET GMPLGBL=$NAME(@GMPLGBL)
+10 ;Load the file contents into ^TMP.
+11 SET GMPLLHF=$$FTG^%ZISH(GMPLPATH,GMPLFILE,GMPLGBL,3)
+12 IF GMPLLHF=0
DO EN^DDIOL("The host file load failed")
HANG 2
KILL ^TMP($JOB,"GMPLHCSV")
QUIT 0
+13 DO RBLCKHF^GMPLSLI2("GMPLHCSV",GMPLNOUT)
+14 KILL ^TMP($JOB,"GMPLHCSV")
+15 QUIT 1
+16 ;============================================
LOADWEB(GMPLNOUT) ;Load the CSV file from a web site into ^TMP
+1 NEW DIR,GMPLHDR,GMPLRSLT,GMPLTXT,GMPLURL,Y
+2 SET DIR(0)="F^10:245"
+3 SET DIR("A")="Input the URL for the CSV file"
+4 DO ^DIR
+5 IF (Y="")!(Y=U)
QUIT 0
+6 SET GMPLURL=Y
+7 SET Y=$$LOW^XLFSTR(Y)
+8 ;Load the file contents into ^TMP.
+9 KILL ^TMP($JOB,GMPLNOUT),^TMP($JOB,"GMPLWCSV")
+10 ;DBIA #5553
+11 SET GMPLRSLT=$$GETURL^XTHC10(GMPLURL,10,"^TMP($J,""GMPLWCSV"")",.GMPLHDR)
+12 IF $PIECE(GMPLRSLT,U,1)'=200
Begin DoDot:1
+13 SET GMPLTXT="Could not load the csv file: "
+14 SET GMPLTXT=GMPLTXT_"Error "_$PIECE(GMPLRSLT,U,1)_" "_$PIECE(GMPLRSLT,U,2)
+15 DO EN^DDIOL(.GMPLTXT)
HANG 2
+16 KILL ^TMP($JOB,"GMPLWCSV")
End DoDot:1
QUIT 0
+17 DO RBLCKWEB^GMPLSLI2("GMPLWCSV",GMPLNOUT)
+18 KILL ^TMP($JOB,"GMPLWCSV")
+19 QUIT 1
+20 ;============================================
MSGHNDL(GMPLNODE,GMPLRNDE) ; Message prompt and handling
+1 NEW GMPLANS,GMPLSVOK,GMPLPUOK,GMPLMSG
+2 SET GMPLANS=$$ASKYN^GMPLUTL4("Y","Do you want to review the problem selection list contents")
+3 IF GMPLANS
DO BROWSE^DDBR("^TMP($J,"""_GMPLRNDE_""")","NR","Selection List Contents To Be Imported")
+4 SET GMPLANS=$$ASKYN^GMPLUTL4("N","Do you want to save the imported list contents")
+5 IF GMPLANS
Begin DoDot:1
+6 SET GMPLSVOK=$$UPDTCNT(GMPLNODE)
+7 IF GMPLSVOK
Begin DoDot:2
+8 SET GMPLPUOK=$$POSTUPDT(GMPLNODE)
+9 IF GMPLPUOK
DO EN^DDIOL("Import process completed successfully.","","!!")
+10 IF '$TEST
Begin DoDot:3
+11 SET GMPLMSG(1)="Import process partially failed due to the above errors."
+12 SET GMPLMSG(1,"F")="!!"
+13 SET GMPLMSG(2)="Some content may/may not have been saved completely."
+14 SET GMPLMSG(3)="Verify newly imported content w/the import file, correct any errors, & re-import"
+15 DO EN^DDIOL(.GMPLMSG)
End DoDot:3
End DoDot:2
End DoDot:1
+16 IF '$TEST
DO EN^DDIOL("Import process aborted.","","!!")
+17 QUIT
+18 ;============================================
POSTUPDT(GMPLNODE) ; Save the list categories & diagnoses
+1 NEW GMPLI,GMPLREC,GMPLFLAG,GMPLLNME,GMPLCCLS
+2 NEW GMPLCLS,GMPLCNME,GMPLADDC,GMPLOK
+3 SET (GMPLI,GMPLADDC)=0
SET GMPLOK=1
+4 FOR
SET GMPLI=$ORDER(^TMP($JOB,GMPLNODE,GMPLI))
if GMPLI=""
QUIT
Begin DoDot:1
+5 SET GMPLREC=^TMP($JOB,GMPLNODE,GMPLI,1)
+6 IF GMPLREC=""
QUIT
+7 SET GMPLFLAG=$PIECE(GMPLREC,",",1)
+8 IF GMPLI=1
Begin DoDot:2
+9 SET GMPLLNME=$PIECE(GMPLREC,",",2)
SET GMPLCCLS=$$UP^XLFSTR($PIECE(GMPLREC,",",4))
+10 SET GMPLCLS=$SELECT(GMPLCCLS="NATIONAL":"N",GMPLCCLS="LOCAL":"L",GMPLCCLS="VISN":"V",1:"")
End DoDot:2
+11 ; Retrieve & save category info
+12 IF GMPLFLAG'>0
IF (GMPLI>1)
Begin DoDot:2
+13 SET GMPLCNME=$$UP^XLFSTR($PIECE(GMPLREC,",",3))
SET GMPLADDC=$SELECT(GMPLFLAG="#":1,1:0)
+14 SET GMPLOK=$$SVC12511(GMPLREC,GMPLFLAG,GMPLCLS,GMPLCCLS,GMPLOK)
+15 IF GMPLOK
SET GMPLOK=$$SVC12501(GMPLREC,GMPLFLAG,GMPLLNME,GMPLOK)
End DoDot:2
QUIT
+16 ; Retrieve & save category problems
+17 IF GMPLADDC
IF (GMPLFLAG>0)
Begin DoDot:2
+18 SET GMPLOK=$$SVPROB(GMPLREC,GMPLCNME,GMPLOK)
End DoDot:2
End DoDot:1
+19 IF $DATA(^GMPL(125.11,0))
SET $PIECE(^GMPL(125.11,0),U,3)=0
+20 KILL ^GMPLCIEN(1),^GMPLINRT(1)
+21 QUIT GMPLOK
+22 ;============================================
SVC12501(GMPLREC,GMPLFLAG,GMPLLNME,GMPLOK) ; Save category info into subfile 125.01
+1 NEW GMPLLIEN,GMPLDA,GMPLKFDA,GMPLFDA,GMPLIENS
+2 NEW GMPLCSEQ,GMPLCNME,GMPLSHDR,GMPLMSG,GMPLTXT
+3 SET GMPLCSEQ=$PIECE(GMPLREC,",",2)
SET GMPLCNME=$$UP^XLFSTR($PIECE(GMPLREC,",",3))
+4 SET GMPLSHDR=$PIECE(GMPLREC,",",4)
+5 SET GMPLLIEN=+$$FIND1^DIC(125,"","K",GMPLLNME,"","","GMPLMSG")
+6 IF GMPLFLAG="@"
IF (GMPLLIEN>0)
Begin DoDot:1
+7 SET GMPLDA=+$$FIND1^DIC(125.01,","_GMPLLIEN_",","K",GMPLCNME,"","","GMPLMSG")
+8 IF GMPLDA>0
Begin DoDot:2
+9 SET GMPLKFDA(125.01,""_GMPLDA_","_GMPLLIEN_",",.01)="@"
+10 DO FILE^DIE("K","GMPLKFDA","GMPLMSG")
End DoDot:2
End DoDot:1
GOTO SVCQT
+11 IF GMPLFLAG="@"
GOTO SVCQT
+12 SET GMPLIENS=$SELECT(GMPLLIEN>0:"+2,"_GMPLLIEN_",",1:"+2,+1,")
+13 SET GMPLFDA(125.01,GMPLIENS,.01)=GMPLCNME
+14 SET GMPLFDA(125.01,GMPLIENS,.02)=GMPLCSEQ
+15 SET GMPLFDA(125.01,GMPLIENS,.03)=GMPLSHDR
+16 SET GMPLFDA(125.01,GMPLIENS,.04)="YES"
+17 DO UPDATE^DIE("E","GMPLFDA","","GMPLMSG")
SVCQT IF $DATA(GMPLMSG)
Begin DoDot:1
+1 SET GMPLTXT(1)="Unable to "_$SELECT(GMPLFLAG="@":"delete",1:"store")
+2 SET GMPLTXT(1)=GMPLTXT(1)_" category "_GMPLCNME_" under list "_GMPLLNME
+3 SET GMPLTXT(2)="Error "_GMPLMSG("DIERR",1)_": "_GMPLMSG("DIERR",1,"TEXT",1)
+4 DO EN^DDIOL(.GMPLTXT)
SET GMPLOK=0
End DoDot:1
+5 QUIT GMPLOK
+6 ;============================================
SVC12511(GMPLREC,GMPLFLAG,GMPLCLS,GMPLCCLS,GMPLOK) ; Save category info into file 125.11
+1 NEW GMPLCSEQ,GMPLCNME,GMPLSHDR,GMPLKFDA
+2 NEW GMPLMSG,GMPLFDA,GMPLTXT
+3 KILL ^GMPLCIEN(1),^GMPLINRT(1)
+4 SET GMPLCSEQ=$PIECE(GMPLREC,",",2)
SET GMPLCNME=$$UP^XLFSTR($PIECE(GMPLREC,",",3))
+5 SET GMPLSHDR=$PIECE(GMPLREC,",",4)
+6 ;If there are any existing entries for this category,
+7 ;delete them prior to storing the new set.
+8 SET ^GMPLCIEN(1)=+$$FIND1^DIC(125.11,"","K",GMPLCNME,"","","GMPLMSG")
+9 IF $GET(^GMPLCIEN(1))>0
Begin DoDot:1
+10 SET ^GMPLINRT(1)=^GMPLCIEN(1)
+11 SET GMPLKFDA(125.11,""_$GET(^GMPLCIEN(1))_",",.01)="@"
+12 DO FILE^DIE("K","GMPLKFDA","GMPLMSG")
End DoDot:1
+13 IF '$TEST
SET ^GMPLINRT(1)=""
+14 IF GMPLFLAG="@"
GOTO SVCQT1
+15 SET GMPLFDA(125.11,"+1,",.01)=GMPLCNME
+16 SET GMPLFDA(125.11,"+1,",.02)=$$DT^XLFDT
+17 SET GMPLFDA(125.11,"+1,",.03)=GMPLCLS
+18 DO UPDATE^DIE("","GMPLFDA","^GMPLINRT","GMPLMSG")
SVCQT1 IF $DATA(GMPLMSG)
Begin DoDot:1
+1 SET GMPLTXT(1)="Unable to "_$SELECT(GMPLFLAG="@":"delete",1:"store")
+2 SET GMPLTXT(1)=GMPLTXT(1)_" category "_GMPLCNME_" and class "_GMPLCCLS_" in file #125.11."
+3 SET GMPLTXT(2)="Error "_GMPLMSG("DIERR",1)_": "_GMPLMSG("DIERR",1,"TEXT",1)
+4 DO EN^DDIOL(.GMPLTXT)
SET GMPLOK=0
End DoDot:1
QUIT
+5 QUIT GMPLOK
+6 ;============================================
SVPROB(GMPLREC,GMPLCNME,GMPLOK) ; Save category problems into subfile 125.11
+1 NEW GMPLDTXT,GMPLPSEQ,GMPLICD,GMPLSCTC,GMPLSCTD
+2 NEW GMPLLTRM,GMPLMSG,GMPLTXT,GMPLISTR,GMPLFDA
+3 IF $LENGTH(GMPLREC,",")>5
Begin DoDot:1
+4 NEW GMPLTPC,GMPLDPC,GMPLK
+5 SET GMPLTPC=$LENGTH(GMPLREC,",")
SET GMPLDPC=GMPLTPC-4
SET GMPLDTXT=""
+6 FOR GMPLK=2:1:(GMPLDPC+1)
SET GMPLDTXT=GMPLDTXT_$SELECT(GMPLK>2:",",1:"")_$PIECE(GMPLREC,",",GMPLK)
+7 SET GMPLPSEQ=$$STRIP^XLFSTR($PIECE(GMPLREC,",",1)," ")
SET GMPLDTXT=$$STRIP^XLFSTR(GMPLDTXT,"""")
+8 SET GMPLICD=$$STRIP^XLFSTR($PIECE(GMPLREC,",",(GMPLDPC+2))," ")
+9 SET GMPLSCTC=$$STRIP^XLFSTR($$STRIP^XLFSTR($PIECE(GMPLREC,",",(GMPLDPC+3)),"C")," ")
+10 SET GMPLSCTD=$$STRIP^XLFSTR($$STRIP^XLFSTR($PIECE($PIECE(GMPLREC,",",(GMPLDPC+4)),""_$CHAR(13)_""),"D")," ")
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 SET GMPLPSEQ=$$STRIP^XLFSTR($PIECE(GMPLREC,",",1)," ")
SET GMPLDTXT=$$STRIP^XLFSTR($PIECE(GMPLREC,",",2),"""")
+13 SET GMPLICD=$$STRIP^XLFSTR($PIECE(GMPLREC,",",3)," ")
SET GMPLSCTC=$$STRIP^XLFSTR($$STRIP^XLFSTR($PIECE(GMPLREC,",",4),"C")," ")
+14 SET GMPLSCTD=$$STRIP^XLFSTR($$STRIP^XLFSTR($PIECE($PIECE(GMPLREC,",",5),""_$CHAR(13)_""),"D")," ")
End DoDot:1
+15 SET GMPLLTRM=$$GETEXIEN^GMPLX(GMPLSCTC,GMPLSCTD)
+16 IF GMPLDTXT["sct"
SET GMPLDTXT=$PIECE(GMPLDTXT,"(")_"("_$$UP^XLFSTR($PIECE($PIECE(GMPLDTXT,"(",2)," "))_" "_$PIECE($PIECE(GMPLDTXT,"(",2)," ",2)
+17 IF GMPLDTXT'["SCT"
SET GMPLDTXT=GMPLDTXT_" (SCT "_GMPLSCTC_")"
+18 IF +GMPLLTRM<0
Begin DoDot:1
+19 SET GMPLTXT(1)="Unable to save "_GMPLDTXT
+20 SET GMPLTXT(2)="Error: "_$PIECE(GMPLLTRM,U,2)
+21 DO EN^DDIOL(.GMPLTXT)
SET GMPLOK=0
End DoDot:1
QUIT
+22 SET GMPLISTR=$SELECT(^GMPLCIEN(1)>0:"+2,"_^GMPLCIEN(1)_",",1:"+2,"_^GMPLINRT(1)_",")
+23 SET GMPLFDA(125.111,GMPLISTR,.01)=GMPLLTRM
+24 SET GMPLFDA(125.111,GMPLISTR,.02)=GMPLPSEQ
+25 SET GMPLFDA(125.111,GMPLISTR,.03)=GMPLDTXT
+26 SET GMPLFDA(125.111,GMPLISTR,.04)=GMPLICD
+27 SET GMPLFDA(125.111,GMPLISTR,.05)=GMPLSCTC
+28 SET GMPLFDA(125.111,GMPLISTR,.06)=GMPLSCTD
+29 DO UPDATE^DIE("","GMPLFDA","","GMPLMSG")
+30 IF $DATA(GMPLMSG)
Begin DoDot:1
+31 SET GMPLTXT(1)="Unable to store problem: "_GMPLDTXT_" from category "_GMPLCNME_"."
+32 SET GMPLTXT(2)="Error "_GMPLMSG("DIERR",1)_": "_GMPLMSG("DIERR",1,"TEXT",1)
+33 DO EN^DDIOL(.GMPLTXT)
SET GMPLOK=0
End DoDot:1
+34 QUIT GMPLOK
+35 ;============================================
UPDTCNT(GMPLNODE) ; Save/delete the list name & class
+1 ; Flag indicators: # - Add/edit list, @ - Delete list
+2 NEW GMPLLST,GMPLFDA,GMPLMSG,GMPLLNME,GMPLLCLS,GMPLCLS
+3 NEW GMPLSUC,GMPLTXT,GMPLIEN,GMPLINRT,GMPLFLAG
+4 SET GMPLSUC=1
+5 SET GMPLLST=^TMP($JOB,GMPLNODE,1,1)
+6 SET GMPLFLAG=$PIECE(GMPLLST,",",1)
+7 SET GMPLLNME=$$UP^XLFSTR($PIECE(GMPLLST,",",2))
+8 SET GMPLLCLS=$$UP^XLFSTR($PIECE(GMPLLST,",",3))
+9 SET GMPLCLS=$SELECT(GMPLLCLS="NATIONAL":"N",GMPLLCLS="LOCAL":"L",GMPLLCLS="VISN":"V",1:"")
+10 SET GMPLIEN=+$$FIND1^DIC(125,"","K",GMPLLNME,"","","GMPLMSG")
+11 IF GMPLIEN>0
Begin DoDot:1
+12 SET GMPLINRT(1)=GMPLIEN
+13 SET GMPLFDA(125,""_GMPLIEN_",",.01)="@"
+14 DO FILE^DIE("K","GMPLFDA","GMPLMSG")
End DoDot:1
+15 IF GMPLFLAG="@"
GOTO UPQT
+16 SET GMPLFDA(125,"+1,",.01)=GMPLLNME
+17 SET GMPLFDA(125,"+1,",.02)=$$DT^XLFDT
+18 SET GMPLFDA(125,"+1,",.04)=GMPLCLS
+19 DO UPDATE^DIE("","GMPLFDA","GMPLINRT","GMPLMSG")
UPQT IF $DATA(GMPLMSG)
Begin DoDot:1
+1 SET GMPLTXT(1)="Unable to "_$SELECT(GMPLFLAG="@":"delete",1:"store")
+2 SET GMPLTXT(1)=GMPLTXT(1)_" list "_GMPLLNME_" and class "_GMPLLCLS_" in file #125."
+3 SET GMPLTXT(2)="Error: "_GMPLMSG("DIERR",1,"TEXT",1)
+4 DO EN^DDIOL(.GMPLTXT)
+5 SET GMPLSUC=0
End DoDot:1
+6 ;Reset the 125 0 node so holes are not left.
+7 IF $DATA(^GMPL(125,0))
SET $PIECE(^GMPL(125,0),U,3)=0
+8 QUIT GMPLSUC
+9 ;============================================
VALCAT(GMPLTMP,GMPLFLAG,GMPLIMPT,GMPLRNDE,GMPLABRT) ; Validate category info
+1 NEW GMPLCSEQ,GMPLCNME,GMPLSHDR,GMPLHSTR,GMPLSQST,GMPLNL
+2 SET GMPLCSEQ=$PIECE(GMPLTMP,",",2)
SET GMPLCNME=$PIECE(GMPLTMP,",",3)
+3 SET GMPLSHDR=$PIECE(GMPLTMP,",",4)
SET GMPLHSTR="Subheader: "_GMPLSHDR
+4 SET GMPLNL=$GET(^TMP($JOB,GMPLRNDE))
+5 IF '+$$VFLAG^GMPLINTR(GMPLFLAG)
SET GMPLABRT=1
+6 IF '+$$VSEQ^GMPLINTR(GMPLCSEQ,"Category")
SET GMPLABRT=1
+7 IF '$TEST
SET GMPLSQST="Category Sequence: "_GMPLCSEQ
+8 IF '+$$VNAME^GMPLINTR(GMPLCNME,GMPLIMPT,"Category")
Begin DoDot:1
+9 DO EN^DDIOL(" For category sequence #"_GMPLCSEQ_".")
+10 SET GMPLABRT=1
End DoDot:1
+11 IF 'GMPLABRT
Begin DoDot:1
+12 SET GMPLNL=GMPLNL+1
SET ^TMP($JOB,GMPLRNDE,GMPLNL)=""
+13 SET GMPLNL=GMPLNL+1
SET ^TMP($JOB,GMPLRNDE,GMPLNL)="Category Name: "_GMPLCNME_$SELECT(GMPLFLAG="@":" ***MARKED FOR DELETION!!!***",1:"")
+14 SET GMPLNL=GMPLNL+1
SET ^TMP($JOB,GMPLRNDE,GMPLNL)=$$LJ^XLFSTR(GMPLHSTR,47)_$$LJ^XLFSTR(GMPLSQST,33)
+15 SET GMPLNL=GMPLNL+1
SET ^TMP($JOB,GMPLRNDE,GMPLNL)=""
+16 SET GMPLNL=GMPLNL+1
SET ^TMP($JOB,GMPLRNDE,GMPLNL)="Prob"_$JUSTIFY("SNOMED CT",10)_$JUSTIFY("SNOMED CT",21)
+17 SET GMPLNL=GMPLNL+1
SET ^TMP($JOB,GMPLRNDE,GMPLNL)="Seq"_$JUSTIFY("Concept",9)_$JUSTIFY("Designation",25)_$JUSTIFY("ICD Code",18)_$JUSTIFY("SNOMED CT Description",42)
+18 SET GMPLNL=GMPLNL+1
SET ^TMP($JOB,GMPLRNDE,GMPLNL)=$$REPEAT^XLFSTR("-",150)
End DoDot:1
+19 SET ^TMP($JOB,GMPLRNDE)=GMPLNL
+20 QUIT GMPLABRT
+21 ;============================================
VALCPROB(GMPLTMP,GMPLRNDE,GMPLABRT) ; Validate category problems
+1 NEW GMPLPSEQ,GMPLDTXT,GMPLICD,GMPLSCTC,GMPLSCTD,GMPLNL
+2 SET GMPLNL=$GET(^TMP($JOB,GMPLRNDE))
+3 IF $LENGTH(GMPLTMP,",")>5
Begin DoDot:1
+4 NEW GMPLTPC,GMPLDPC,GMPLK
+5 SET GMPLTPC=$LENGTH(GMPLTMP,",")
SET GMPLDPC=GMPLTPC-4
SET GMPLDTXT=""
+6 FOR GMPLK=2:1:(GMPLDPC+1)
SET GMPLDTXT=GMPLDTXT_$SELECT(GMPLK>2:",",1:"")_$PIECE(GMPLTMP,",",GMPLK)
+7 SET GMPLPSEQ=$$STRIP^XLFSTR($PIECE(GMPLTMP,",",1)," ")
SET GMPLDTXT=$$STRIP^XLFSTR(GMPLDTXT,"""")
+8 SET GMPLICD=$$STRIP^XLFSTR($PIECE(GMPLTMP,",",(GMPLDPC+2))," ")
+9 SET GMPLSCTC=$$STRIP^XLFSTR($$STRIP^XLFSTR($PIECE(GMPLTMP,",",(GMPLDPC+3)),"C")," ")
+10 SET GMPLSCTD=$$STRIP^XLFSTR($$STRIP^XLFSTR($PIECE($PIECE(GMPLTMP,",",(GMPLDPC+4)),""_$CHAR(13)_""),"D")," ")
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 SET GMPLPSEQ=$$STRIP^XLFSTR($PIECE(GMPLTMP,",",1)," ")
SET GMPLDTXT=$$STRIP^XLFSTR($PIECE(GMPLTMP,",",2),"""")
+13 SET GMPLICD=$$STRIP^XLFSTR($PIECE(GMPLTMP,",",3)," ")
SET GMPLSCTC=$$STRIP^XLFSTR($$STRIP^XLFSTR($PIECE(GMPLTMP,",",4),"C")," ")
+14 SET GMPLSCTD=$$STRIP^XLFSTR($$STRIP^XLFSTR($PIECE($PIECE(GMPLTMP,",",5),""_$CHAR(13)_""),"D")," ")
End DoDot:1
+15 IF GMPLDTXT["sct"
SET GMPLDTXT=$PIECE(GMPLDTXT,"(")_"("_$$UP^XLFSTR($PIECE($PIECE(GMPLDTXT,"(",2)," "))_" "_$PIECE($PIECE(GMPLDTXT,"(",2)," ",2)
+16 IF GMPLDTXT'["SCT"
SET GMPLDTXT=GMPLDTXT_" (SCT "_GMPLSCTC_")"
+17 IF '+$$VICD^GMPLINTR(GMPLICD)
SET GMPLABRT=1
+18 IF '+$$VSCTCODE^GMPLINTR(GMPLSCTC)
SET GMPLABRT=1
QUIT GMPLABRT
+19 IF '+$$VSCTDSGN^GMPLINTR(GMPLSCTC,GMPLSCTD,$PIECE(GMPLDTXT," (SCT"))
SET GMPLABRT=1
+20 IF 'GMPLABRT
Begin DoDot:1
+21 SET GMPLNL=GMPLNL+1
SET ^TMP($JOB,GMPLRNDE,GMPLNL)=$$LJ^XLFSTR(GMPLPSEQ,5)_$$LJ^XLFSTR(GMPLSCTC,21)_$$LJ^XLFSTR(GMPLSCTD,21)_$$LJ^XLFSTR(GMPLICD,29)_$$LJ^XLFSTR(GMPLDTXT,80)
End DoDot:1
+22 SET ^TMP($JOB,GMPLRNDE)=GMPLNL
+23 QUIT GMPLABRT
+24 ;============================================
VALSLST(GMPLTMP,GMPLFLAG,GMPLIMPT,GMPLRNDE,GMPLABRT) ; Validate selection list & class
+1 NEW GMPLLNME,GMPLLCLS,GMPLCCLS,GMPLNL
+2 SET GMPLLNME=$PIECE(GMPLTMP,",",2)
SET GMPLLCLS=$PIECE(GMPLTMP,",",3)
+3 SET GMPLCCLS=$PIECE(GMPLTMP,",",4)
SET GMPLNL=0
+4 KILL ^TMP($JOB,GMPLRNDE)
+5 IF GMPLFLAG="@"
SET GMPLNL=GMPLNL+1
SET ^TMP($JOB,GMPLRNDE,GMPLNL)="***MARKED FOR DELETION!!!***"
+6 IF '+$$VFLAG^GMPLINTR(GMPLFLAG)
SET GMPLABRT=1
+7 IF '+$$VNAME^GMPLINTR(GMPLLNME,GMPLIMPT,"List")
SET GMPLABRT=1
+8 IF '+$$VCLASS^GMPLINTR(GMPLLCLS,GMPLIMPT,"List")
SET GMPLABRT=1
+9 IF '+$$VCLASS^GMPLINTR(GMPLCCLS,GMPLIMPT,"Category")
SET GMPLABRT=1
+10 IF 'GMPLABRT
Begin DoDot:1
+11 SET GMPLNL=GMPLNL+1
SET ^TMP($JOB,GMPLRNDE,GMPLNL)="Selection List Name: "_GMPLLNME
+12 SET GMPLNL=GMPLNL+1
SET ^TMP($JOB,GMPLRNDE,GMPLNL)="List Class: "_GMPLLCLS_$JUSTIFY("Category Class: ",34)_GMPLCCLS
End DoDot:1
+13 SET ^TMP($JOB,GMPLRNDE)=GMPLNL
+14 QUIT GMPLABRT
