GMPLSLI1.m

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 ---GMPLSLI1   15521     printed  Apr 23, 2025@18:44:55                                                                                                                                                                                                   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)