SDES2ENTERLETTR2 ;ALB/BLB,TJB - SDES2 CREATE LETTER 2 ;June 30, 2025@04:30pm
;;5.3;Scheduling;**916,918**;Aug 13, 1993;Build 4
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
CREATELETTER(JSONRETURN,SDCONTEXT,LETTER) ;
N SAVETYPE
S SAVETYPE="CREATE"
D SAVELETTER(.JSONRETURN,.SDCONTEXT,.LETTER,SAVETYPE)
Q
;
EDITLETTER(JSONRETURN,SDCONTEXT,LETTER) ;
N SAVETYPE
S SAVETYPE="EDIT"
D SAVELETTER(.JSONRETURN,.SDCONTEXT,.LETTER,SAVETYPE)
Q
;
DELETELETTER(JSONRETURN,SDCONTEXT,LETTER) ;
N %,DA,DIK,ERRORS,RETURN,VALRETURN,X,Y
;
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("Letter",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
;
; Validate LETTER IEN - Only input field for DELETES
D VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,407.5,$G(LETTER("LETTER IEN")),1,,630,624)
I $D(ERRORS) S ERRORS("Letter",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
;
; Verify that no clinic is pointing to this letter
S DA=LETTER("LETTER IEN")
I $D(^SC("ALTN",DA))!$D(^SC("ALTP",DA))!$D(^SC("ALTC",DA))!$D(^SC("ALTA",DA)) D Q
. D ERRLOG^SDES2JSON(.ERRORS,52,"There are Clinics pointing to this letter. Must remove or change the letter on the clinic")
. S ERRORS("Letter",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)
;
S DIK="^VA(407.5,"
D ^DIK
;
S RETURN("Letter","IEN")="LETTER IEN "_LETTER("LETTER IEN")_" has successfully been deleted."
D BUILDJSON^SDES2JSON(.JSONRETURN,.RETURN)
Q
;
SAVELETTER(JSONRETURN,SDCONTEXT,LETTER,SAVETYPE) ;
N ERRORS,RETURN
;
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("Letter",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
;
D VALIDATE(.ERRORS,.LETTER,SAVETYPE)
I $D(ERRORS) S ERRORS("Letter",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
;
D BUILDER(.ERRORS,.LETTER)
I $D(ERRORS) S ERRORS("Letter",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
;
S RETURN("Letter","IEN")=LETTER("LETTER IEN")
D BUILDJSON^SDES2JSON(.JSONRETURN,.RETURN)
Q
;
VALIDATE(ERRORS,LETTER,SAVETYPE) ; Validation for Input Parameter data
N MESSTYPIEN,VALRETURN,LETIENS,LIEN
; Validate required fields
;
; LETTER NAME
D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,407.5,.01,$G(LETTER("LETTER NAME")),1,,620,621)
Q:$D(ERRORS)
S LETTER("LETTER NAME")=$$CTRL^XMXUTIL1(LETTER("LETTER NAME"))
;
; LETTER TYPE
I $G(LETTER("LETTER TYPE"))="" D ERRLOG^SDES2JSON(.ERRORS,622) Q
I '$D(^VA(407.6,"B",$G(LETTER("LETTER TYPE")))) D ERRLOG^SDES2JSON(.ERRORS,623) Q
;I '$$FIND1^DIC(407.6,"","B",$G(LETTER("LETTER TYPE"))) D ERRLOG^SDES2JSON(.ERRORS,623) Q
;
S LIEN=""
F S LIEN=$O(^VA(407.5,"B",$G(LETTER("LETTER NAME")),LIEN)) Q:'+LIEN S LETIENS(LETTER("LETTER NAME"),$P(^VA(407.5,LIEN,0),U,2),LIEN)=""
; Existing letter with this name and letter type
I SAVETYPE="CREATE",$D(^VA(407.5,"B",$G(LETTER("LETTER NAME")))) D Q:$D(ERRORS)
. I $O(LETIENS(LETTER("LETTER NAME"),LETTER("LETTER TYPE"),""))'="" D ERRLOG^SDES2JSON(.ERRORS,629,"Existing letter found with same name and type") Q
; Validate LETTER IEN - Required for EDITS, not used for CREATES
I SAVETYPE="EDIT" D
. D VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,407.5,$G(LETTER("LETTER IEN")),1,,630,624) Q:$D(ERRORS)
. I $$GET1^DIQ(407.5,$G(LETTER("LETTER IEN"))_",",1,"I")=LETTER("LETTER TYPE"),($$GET1^DIQ(407.5,$G(LETTER("LETTER IEN"))_",",.01,"E")=$G(LETTER("LETTER NAME"))) Q
. S LIEN="",LIEN=$O(LETIENS(LETTER("LETTER NAME"),LETTER("LETTER TYPE"),""))
. I ($O(LETIENS(LETTER("LETTER NAME"),LETTER("LETTER TYPE"),""))'=""),LIEN'=$G(LETTER("LETTER IEN")) D ERRLOG^SDES2JSON(.ERRORS,82,"Letter IEN. Letter Name and Letter Type matches existing letter with different Letter IEN") Q
Q:$D(ERRORS)
;
; PRINT DEFAULT PROVIDER
I $D(LETTER("DEFAULT PROVIDER")) D
.D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,407.5,4,$G(LETTER("DEFAULT PROVIDER")),,1,,627)
Q:$D(ERRORS)
;
; PRINT CLINIC LOCATION
I $D(LETTER("CLINIC LOCATION")) D
.D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,407.5,5,$G(LETTER("CLINIC LOCATION")),,1,,628)
Q
;
BUILDER(ERRORS,LETTER) ; Build FDA array and save LETTER
N EDITFINAL,EDITINITIAL,FDA,FDAERR,LETTIEN,NEWIEN
S LETTIEN=$S($G(LETTER("LETTER IEN")):LETTER("LETTER IEN")_",",1:"+1,")
;
S FDA(407.5,LETTIEN,.01)=LETTER("LETTER NAME")
S FDA(407.5,LETTIEN,1)=LETTER("LETTER TYPE")
I $D(LETTER("DEFAULT PROVIDER")) S FDA(407.5,LETTIEN,4)=$G(LETTER("DEFAULT PROVIDER"))
I $D(LETTER("CLINIC LOCATION")) S FDA(407.5,LETTIEN,5)=$G(LETTER("CLINIC LOCATION"))
;
I $G(LETTER("LETTER IEN")) D Q:$D(ERRORS)
. D FILE^DIE(,"FDA","FDAERR") K FDA
. I $D(FDAERR) D ERRLOG^SDES2JSON(.ERRORS,629) Q
;
I '$G(LETTER("LETTER IEN")) D Q:$D(ERRORS)
. D UPDATE^DIE(,"FDA","NEWIEN","FDAERR")
. I $D(FDAERR) D ERRLOG^SDES2JSON(.ERRORS,629) Q
. S LETTER("LETTER IEN")=NEWIEN(1)
. S LETTIEN=NEWIEN(1)_"," K FDA
;
D STORELETSECTIONS(.LETTER,$S($G(NEWIEN(1)):NEWIEN(1),1:$G(LETTER("LETTER IEN"))))
Q
;
STORELETSECTIONS(LETTER,LETTERIEN) ;
N COUNT,INITIALSECTIONS,FINALSECTIONS
;
F COUNT=1:1:$O(LETTER("INITIAL SECTION",""),-1) D
.S INITIALSECTIONS(COUNT)=$$CTRL^XMXUTIL1($G(LETTER("INITIAL SECTION",COUNT)))
;
F COUNT=1:1:$O(LETTER("FINAL SECTION",""),-1) D
.S FINALSECTIONS(COUNT)=$$CTRL^XMXUTIL1($G(LETTER("FINAL SECTION",COUNT)))
;
I $D(INITIALSECTIONS) D WP^DIE(407.5,LETTERIEN_",",2,"","INITIALSECTIONS")
I $D(FINALSECTIONS) D WP^DIE(407.5,LETTERIEN_",",3,"","FINALSECTIONS")
Q
;
SEARCHLETTER(JSONRETURN,SDCONTEXT,SEARCH) ;
;
; SEARCH INPUT FORMAT
;
;S SEARCH("LETTER TYPE")="" REQ
;S SEARCH("SEARCH STRING")="" OPT
;
N ERRORS,RETURN
;
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("Search",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
;
D VALSEARCH(.ERRORS,.SEARCH)
I $D(ERRORS) S ERRORS("Search",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
;
D BUILDLIST(.RETURN,.ERRORS,.SEARCH)
I $D(ERRORS) S ERRORS("Search",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
;
D BUILDJSON^SDES2JSON(.JSONRETURN,.RETURN)
Q
;
VALSEARCH(ERRORS,SEARCH) ;
;
; LETTER TYPE
I $G(SEARCH("LETTER TYPE"))="" D ERRLOG^SDES2JSON(.ERRORS,622) Q
I '$D(^VA(407.6,"B",$G(SEARCH("LETTER TYPE")))) D ERRLOG^SDES2JSON(.ERRORS,623) Q
;I '$$FIND1^DIC(407.6,"","B",$G(SEARCH("LETTER TYPE"))) D ERRLOG^SDES2JSON(.ERRORS,623) Q
;
; SEARCH STRING
Q:$G(SEARCH("SEARCH STRING"))=""
S SEARCH("SEARCH STRING")=$$CTRL^XMXUTIL1(SEARCH("SEARCH STRING"))
I ($L(SEARCH("SEARCH STRING"))<3)!($L(SEARCH("SEARCH STRING"))>35) D ERRLOG^SDES2JSON(.ERRORS,230) Q
;
Q
;
BUILDLIST(RETURN,ERRORS,SEARCH) ;
; Search for matches
N LETIEN,LETLIST,LETNAME,LETTYPE
S LETTYPE=$G(SEARCH("LETTER TYPE")) Q:LETTYPE=""
S LETIEN=0
F S LETIEN=$O(^VA(407.5,"C",LETTYPE,LETIEN)) Q:'LETIEN D
. S LETNAME=$$GET1^DIQ(407.5,LETIEN_",",.01,"E")
. S LETLIST(LETNAME,LETIEN)=""
I $G(SEARCH("SEARCH STRING"))'="" D
. S LETNAME=""
. F S LETNAME=$O(LETLIST(LETNAME)) Q:LETNAME="" D
. . I LETNAME'[(SEARCH("SEARCH STRING")) K LETLIST(LETNAME)
;
; Format return data
I '$D(LETLIST) D Q
. D ERRLOG^SDES2JSON(.RETURN,631) S RETURN("Search",1)="" Q
N LETCOUNT
S LETNAME="",LETCOUNT=0
F S LETNAME=$O(LETLIST(LETNAME)) Q:LETNAME="" D
. S LETIEN=0
. F S LETIEN=$O(LETLIST(LETNAME,LETIEN)) Q:'LETIEN D
. . S LETCOUNT=LETCOUNT+1
. . S RETURN("Search",LETCOUNT,"LetterIEN")=LETIEN
. . S RETURN("Search",LETCOUNT,"LetterName")=LETNAME
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2ENTERLETTR2 7599 printed Jan 29, 2026@15:52:56 Page 2
SDES2ENTERLETTR2 ;ALB/BLB,TJB - SDES2 CREATE LETTER 2 ;June 30, 2025@04:30pm
+1 ;;5.3;Scheduling;**916,918**;Aug 13, 1993;Build 4
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
CREATELETTER(JSONRETURN,SDCONTEXT,LETTER) ;
+1 NEW SAVETYPE
+2 SET SAVETYPE="CREATE"
+3 DO SAVELETTER(.JSONRETURN,.SDCONTEXT,.LETTER,SAVETYPE)
+4 QUIT
+5 ;
EDITLETTER(JSONRETURN,SDCONTEXT,LETTER) ;
+1 NEW SAVETYPE
+2 SET SAVETYPE="EDIT"
+3 DO SAVELETTER(.JSONRETURN,.SDCONTEXT,.LETTER,SAVETYPE)
+4 QUIT
+5 ;
DELETELETTER(JSONRETURN,SDCONTEXT,LETTER) ;
+1 NEW %,DA,DIK,ERRORS,RETURN,VALRETURN,X,Y
+2 ;
+3 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+4 IF $DATA(ERRORS)
SET ERRORS("Letter",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)
QUIT
+5 ;
+6 ; Validate LETTER IEN - Only input field for DELETES
+7 DO VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,407.5,$GET(LETTER("LETTER IEN")),1,,630,624)
+8 IF $DATA(ERRORS)
SET ERRORS("Letter",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)
QUIT
+9 ;
+10 ; Verify that no clinic is pointing to this letter
+11 SET DA=LETTER("LETTER IEN")
+12 IF $DATA(^SC("ALTN",DA))!$DATA(^SC("ALTP",DA))!$DATA(^SC("ALTC",DA))!$DATA(^SC("ALTA",DA))
Begin DoDot:1
+13 DO ERRLOG^SDES2JSON(.ERRORS,52,"There are Clinics pointing to this letter. Must remove or change the letter on the clinic")
+14 SET ERRORS("Letter",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)
End DoDot:1
QUIT
+15 ;
+16 SET DIK="^VA(407.5,"
+17 DO ^DIK
+18 ;
+19 SET RETURN("Letter","IEN")="LETTER IEN "_LETTER("LETTER IEN")_" has successfully been deleted."
+20 DO BUILDJSON^SDES2JSON(.JSONRETURN,.RETURN)
+21 QUIT
+22 ;
SAVELETTER(JSONRETURN,SDCONTEXT,LETTER,SAVETYPE) ;
+1 NEW ERRORS,RETURN
+2 ;
+3 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+4 IF $DATA(ERRORS)
SET ERRORS("Letter",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)
QUIT
+5 ;
+6 DO VALIDATE(.ERRORS,.LETTER,SAVETYPE)
+7 IF $DATA(ERRORS)
SET ERRORS("Letter",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)
QUIT
+8 ;
+9 DO BUILDER(.ERRORS,.LETTER)
+10 IF $DATA(ERRORS)
SET ERRORS("Letter",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)
QUIT
+11 ;
+12 SET RETURN("Letter","IEN")=LETTER("LETTER IEN")
+13 DO BUILDJSON^SDES2JSON(.JSONRETURN,.RETURN)
+14 QUIT
+15 ;
VALIDATE(ERRORS,LETTER,SAVETYPE) ; Validation for Input Parameter data
+1 NEW MESSTYPIEN,VALRETURN,LETIENS,LIEN
+2 ; Validate required fields
+3 ;
+4 ; LETTER NAME
+5 DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,407.5,.01,$GET(LETTER("LETTER NAME")),1,,620,621)
+6 if $DATA(ERRORS)
QUIT
+7 SET LETTER("LETTER NAME")=$$CTRL^XMXUTIL1(LETTER("LETTER NAME"))
+8 ;
+9 ; LETTER TYPE
+10 IF $GET(LETTER("LETTER TYPE"))=""
DO ERRLOG^SDES2JSON(.ERRORS,622)
QUIT
+11 IF '$DATA(^VA(407.6,"B",$GET(LETTER("LETTER TYPE"))))
DO ERRLOG^SDES2JSON(.ERRORS,623)
QUIT
+12 ;I '$$FIND1^DIC(407.6,"","B",$G(LETTER("LETTER TYPE"))) D ERRLOG^SDES2JSON(.ERRORS,623) Q
+13 ;
+14 SET LIEN=""
+15 FOR
SET LIEN=$ORDER(^VA(407.5,"B",$GET(LETTER("LETTER NAME")),LIEN))
if '+LIEN
QUIT
SET LETIENS(LETTER("LETTER NAME"),$PIECE(^VA(407.5,LIEN,0),U,2),LIEN)=""
+16 ; Existing letter with this name and letter type
+17 IF SAVETYPE="CREATE"
IF $DATA(^VA(407.5,"B",$GET(LETTER("LETTER NAME"))))
Begin DoDot:1
+18 IF $ORDER(LETIENS(LETTER("LETTER NAME"),LETTER("LETTER TYPE"),""))'=""
DO ERRLOG^SDES2JSON(.ERRORS,629,"Existing letter found with same name and type")
QUIT
End DoDot:1
if $DATA(ERRORS)
QUIT
+19 ; Validate LETTER IEN - Required for EDITS, not used for CREATES
+20 IF SAVETYPE="EDIT"
Begin DoDot:1
+21 DO VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,407.5,$GET(LETTER("LETTER IEN")),1,,630,624)
if $DATA(ERRORS)
QUIT
+22 IF $$GET1^DIQ(407.5,$GET(LETTER("LETTER IEN"))_",",1,"I")=LETTER("LETTER TYPE")
IF ($$GET1^DIQ(407.5,$GET(LETTER("LETTER IEN"))_",",.01,"E")=$GET(LETTER("LETTER NAME")))
QUIT
+23 SET LIEN=""
SET LIEN=$ORDER(LETIENS(LETTER("LETTER NAME"),LETTER("LETTER TYPE"),""))
+24 IF ($ORDER(LETIENS(LETTER("LETTER NAME"),LETTER("LETTER TYPE"),""))'="")
IF LIEN'=$GET(LETTER("LETTER IEN"))
DO ERRLOG^SDES2JSON(.ERRORS,82,"Letter IEN. Letter Name and Letter Type matches existing letter with different Letter IEN")
QUIT
End DoDot:1
+25 if $DATA(ERRORS)
QUIT
+26 ;
+27 ; PRINT DEFAULT PROVIDER
+28 IF $DATA(LETTER("DEFAULT PROVIDER"))
Begin DoDot:1
+29 DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,407.5,4,$GET(LETTER("DEFAULT PROVIDER")),,1,,627)
End DoDot:1
+30 if $DATA(ERRORS)
QUIT
+31 ;
+32 ; PRINT CLINIC LOCATION
+33 IF $DATA(LETTER("CLINIC LOCATION"))
Begin DoDot:1
+34 DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,407.5,5,$GET(LETTER("CLINIC LOCATION")),,1,,628)
End DoDot:1
+35 QUIT
+36 ;
BUILDER(ERRORS,LETTER) ; Build FDA array and save LETTER
+1 NEW EDITFINAL,EDITINITIAL,FDA,FDAERR,LETTIEN,NEWIEN
+2 SET LETTIEN=$SELECT($GET(LETTER("LETTER IEN")):LETTER("LETTER IEN")_",",1:"+1,")
+3 ;
+4 SET FDA(407.5,LETTIEN,.01)=LETTER("LETTER NAME")
+5 SET FDA(407.5,LETTIEN,1)=LETTER("LETTER TYPE")
+6 IF $DATA(LETTER("DEFAULT PROVIDER"))
SET FDA(407.5,LETTIEN,4)=$GET(LETTER("DEFAULT PROVIDER"))
+7 IF $DATA(LETTER("CLINIC LOCATION"))
SET FDA(407.5,LETTIEN,5)=$GET(LETTER("CLINIC LOCATION"))
+8 ;
+9 IF $GET(LETTER("LETTER IEN"))
Begin DoDot:1
+10 DO FILE^DIE(,"FDA","FDAERR")
KILL FDA
+11 IF $DATA(FDAERR)
DO ERRLOG^SDES2JSON(.ERRORS,629)
QUIT
End DoDot:1
if $DATA(ERRORS)
QUIT
+12 ;
+13 IF '$GET(LETTER("LETTER IEN"))
Begin DoDot:1
+14 DO UPDATE^DIE(,"FDA","NEWIEN","FDAERR")
+15 IF $DATA(FDAERR)
DO ERRLOG^SDES2JSON(.ERRORS,629)
QUIT
+16 SET LETTER("LETTER IEN")=NEWIEN(1)
+17 SET LETTIEN=NEWIEN(1)_","
KILL FDA
End DoDot:1
if $DATA(ERRORS)
QUIT
+18 ;
+19 DO STORELETSECTIONS(.LETTER,$SELECT($GET(NEWIEN(1)):NEWIEN(1),1:$GET(LETTER("LETTER IEN"))))
+20 QUIT
+21 ;
STORELETSECTIONS(LETTER,LETTERIEN) ;
+1 NEW COUNT,INITIALSECTIONS,FINALSECTIONS
+2 ;
+3 FOR COUNT=1:1:$ORDER(LETTER("INITIAL SECTION",""),-1)
Begin DoDot:1
+4 SET INITIALSECTIONS(COUNT)=$$CTRL^XMXUTIL1($GET(LETTER("INITIAL SECTION",COUNT)))
End DoDot:1
+5 ;
+6 FOR COUNT=1:1:$ORDER(LETTER("FINAL SECTION",""),-1)
Begin DoDot:1
+7 SET FINALSECTIONS(COUNT)=$$CTRL^XMXUTIL1($GET(LETTER("FINAL SECTION",COUNT)))
End DoDot:1
+8 ;
+9 IF $DATA(INITIALSECTIONS)
DO WP^DIE(407.5,LETTERIEN_",",2,"","INITIALSECTIONS")
+10 IF $DATA(FINALSECTIONS)
DO WP^DIE(407.5,LETTERIEN_",",3,"","FINALSECTIONS")
+11 QUIT
+12 ;
SEARCHLETTER(JSONRETURN,SDCONTEXT,SEARCH) ;
+1 ;
+2 ; SEARCH INPUT FORMAT
+3 ;
+4 ;S SEARCH("LETTER TYPE")="" REQ
+5 ;S SEARCH("SEARCH STRING")="" OPT
+6 ;
+7 NEW ERRORS,RETURN
+8 ;
+9 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+10 IF $DATA(ERRORS)
SET ERRORS("Search",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)
QUIT
+11 ;
+12 DO VALSEARCH(.ERRORS,.SEARCH)
+13 IF $DATA(ERRORS)
SET ERRORS("Search",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)
QUIT
+14 ;
+15 DO BUILDLIST(.RETURN,.ERRORS,.SEARCH)
+16 IF $DATA(ERRORS)
SET ERRORS("Search",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)
QUIT
+17 ;
+18 DO BUILDJSON^SDES2JSON(.JSONRETURN,.RETURN)
+19 QUIT
+20 ;
VALSEARCH(ERRORS,SEARCH) ;
+1 ;
+2 ; LETTER TYPE
+3 IF $GET(SEARCH("LETTER TYPE"))=""
DO ERRLOG^SDES2JSON(.ERRORS,622)
QUIT
+4 IF '$DATA(^VA(407.6,"B",$GET(SEARCH("LETTER TYPE"))))
DO ERRLOG^SDES2JSON(.ERRORS,623)
QUIT
+5 ;I '$$FIND1^DIC(407.6,"","B",$G(SEARCH("LETTER TYPE"))) D ERRLOG^SDES2JSON(.ERRORS,623) Q
+6 ;
+7 ; SEARCH STRING
+8 if $GET(SEARCH("SEARCH STRING"))=""
QUIT
+9 SET SEARCH("SEARCH STRING")=$$CTRL^XMXUTIL1(SEARCH("SEARCH STRING"))
+10 IF ($LENGTH(SEARCH("SEARCH STRING"))<3)!($LENGTH(SEARCH("SEARCH STRING"))>35)
DO ERRLOG^SDES2JSON(.ERRORS,230)
QUIT
+11 ;
+12 QUIT
+13 ;
BUILDLIST(RETURN,ERRORS,SEARCH) ;
+1 ; Search for matches
+2 NEW LETIEN,LETLIST,LETNAME,LETTYPE
+3 SET LETTYPE=$GET(SEARCH("LETTER TYPE"))
if LETTYPE=""
QUIT
+4 SET LETIEN=0
+5 FOR
SET LETIEN=$ORDER(^VA(407.5,"C",LETTYPE,LETIEN))
if 'LETIEN
QUIT
Begin DoDot:1
+6 SET LETNAME=$$GET1^DIQ(407.5,LETIEN_",",.01,"E")
+7 SET LETLIST(LETNAME,LETIEN)=""
End DoDot:1
+8 IF $GET(SEARCH("SEARCH STRING"))'=""
Begin DoDot:1
+9 SET LETNAME=""
+10 FOR
SET LETNAME=$ORDER(LETLIST(LETNAME))
if LETNAME=""
QUIT
Begin DoDot:2
+11 IF LETNAME'[(SEARCH("SEARCH STRING"))
KILL LETLIST(LETNAME)
End DoDot:2
End DoDot:1
+12 ;
+13 ; Format return data
+14 IF '$DATA(LETLIST)
Begin DoDot:1
+15 DO ERRLOG^SDES2JSON(.RETURN,631)
SET RETURN("Search",1)=""
QUIT
End DoDot:1
QUIT
+16 NEW LETCOUNT
+17 SET LETNAME=""
SET LETCOUNT=0
+18 FOR
SET LETNAME=$ORDER(LETLIST(LETNAME))
if LETNAME=""
QUIT
Begin DoDot:1
+19 SET LETIEN=0
+20 FOR
SET LETIEN=$ORDER(LETLIST(LETNAME,LETIEN))
if 'LETIEN
QUIT
Begin DoDot:2
+21 SET LETCOUNT=LETCOUNT+1
+22 SET RETURN("Search",LETCOUNT,"LetterIEN")=LETIEN
+23 SET RETURN("Search",LETCOUNT,"LetterName")=LETNAME
End DoDot:2
End DoDot:1
+24 QUIT
