- SDESGETLETTERS ;ALB/BWF - VISTA SCHEDULING RPCS ;JUNE 10, 2022
- ;;5.3;Scheduling;**819**;Aug 13, 1993;Build 5
- ;;Per VHA Directive 6402, this routine should not be modified
- ;
- Q
- ; return letter types for the LETTER TYPE file (#407.6)
- GETLETTERTYPES(RES,EAS) ;
- N X,LCNT,LETARRY,ERR
- D VALIDATEEAS(.ERR,$G(EAS))
- I $D(ERR) D Q
- .S ERR("LetterType",1)=""
- .D BUILDJSON^SDESBUILDJSON(.RES,.ERR)
- S X=0
- F S X=$O(^VA(407.6,X)) Q:'X D
- .S LCNT=$G(LCNT)+1
- .S LETARRY("LetterType",LCNT,"Type")=$$GET1^DIQ(407.6,X,.01,"E")
- .S LETARRY("LetterType",LCNT,"Name")=$$GET1^DIQ(407.6,X,1,"E")
- I '$D(LETARRY) S LETARRY("LetterType",1)=""
- D BUILDJSON^SDESBUILDJSON(.RES,.LETARRY)
- Q
- ; 407.5 - LETTER
- ; 407.6 - LETTER TYPE
- ; 403.52 - RECALL REMINDERS LETTERS
- ; get a list of all letters ,full text
- ; TYPE - type of letter (N - NO show, A - Appointment Cancellation, P - PreAppointment Cancellation, C - Clinic Cancelled)
- ; TEXT - (optional) text to match
- ; BRIEF - 1 for brief data return (no letter text), 0 or "" for full letter/letter text
- GETLETTERSBYTYPE(RES,TYPE,TEXT,BRIEF,EAS) ;
- N LETIEN,LCNT,LETARRY,F,ERR
- S F=407.5
- D VALLETTERTYPE(.ERR,TYPE)
- D VALLETTERTEXT(.ERR,TEXT)
- D VALIDATEEAS(.ERR,$G(EAS))
- I $D(ERR) D Q
- .S ERR("Letter",1)=""
- .D BUILDJSON^SDESBUILDJSON(.RES,.ERR) Q
- S (LETIEN,LCNT)=0
- F S LETIEN=$O(^VA(F,"C",TYPE,LETIEN)) Q:'LETIEN D
- .I $L($G(TEXT)),$E($$GET1^DIQ(F,LETIEN,.01,"E"),1,$L(TEXT))'=TEXT Q
- .D BUILDLETTER(.LETARRY,LETIEN,.LCNT,$G(BRIEF))
- I '$D(LETARRY) S LETARRY("Letter",1)=""
- D BUILDJSON^SDESBUILDJSON(.RES,.LETARRY)
- Q
- ;
- GETLETTERBYIEN(RES,IEN,EAS) ;
- N ERR,LETARRY,CNT
- D VALLETTERIEN(.ERR,IEN)
- D VALIDATEEAS(.ERR,$G(EAS))
- I $D(ERR) D Q
- .S ERR("Letter",1)=""
- .D BUILDJSON^SDESBUILDJSON(.RES,.ERR) Q
- S CNT=$G(CNT)+1
- D BUILDLETTER(.LETARRY,IEN,.CNT)
- I '$D(LETARRY) S LETARRY("Letter",1)=""
- D BUILDJSON^SDESBUILDJSON(.RES,.LETARRY)
- Q
- ; BRIEF - indicates a brief list, without the letter text
- BUILDLETTER(LETARRY,IEN,LCNT,BRIEF) ;
- N LETDATA,LIENS,LETDATA,INITSEC,FINSEC,LIENS,F,LETTERIEN,LETTERTYPE
- S F=407.5
- S LCNT=$G(LCNT)+1
- S LIENS=IEN_","
- D GETS^DIQ(F,IEN_",","**","IE","LETDATA")
- S LETARRY("Letter",LCNT,"ID")=IEN
- S LETARRY("Letter",LCNT,"Name")=$G(LETDATA(F,LIENS,.01,"E"))
- S TYPE=$$GET1^DIQ(407.5,IEN,1,"E")
- S LETTERIEN=$O(^VA(407.6,"B",TYPE,0))
- S LETTERTYPE=$$GET1^DIQ(407.6,LETTERIEN,1,"E")
- S LETARRY("Letter",LCNT,"Type")=LETTERTYPE
- Q:$G(BRIEF)
- S LETARRY("Letter",LCNT,"PrintDefaultProvider")=$G(LETDATA(F,LIENS,4,"E"))
- S LETARRY("Letter",LCNT,"PrintClinicLocation")=$G(LETDATA(F,LIENS,5,"E"))
- S INITSEC=0
- F S INITSEC=$O(LETDATA(F,LIENS,2,INITSEC)) Q:'INITSEC D
- .S LETARRY("Letter",LCNT,"InitialSection",INITSEC)=$G(LETDATA(F,LIENS,2,INITSEC))
- S FINSEC=0
- F S FINSEC=$O(LETDATA(F,LIENS,3,FINSEC)) Q:'FINSEC D
- .S LETARRY("Letter",LCNT,"FinalSection",FINSEC)=$G(LETDATA(F,LIENS,3,FINSEC))
- Q
- VALLETTERIEN(ERRORS,IEN) ;
- I '$L($G(IEN)) D ERRLOG^SDESJSON(.ERRORS,227) Q
- I '$D(^VA(407.5,IEN)) D ERRLOG^SDESJSON(.ERRORS,225)
- Q
- VALLETTERTYPE(ERRORS,TYPE) ;
- I '$L($G(TYPE)) D ERRLOG^SDESJSON(.ERRORS,228) Q
- I '$D(^VA(407.5,"C",TYPE)) D ERRLOG^SDESJSON(.ERRORS,226)
- Q
- VALLETTERTEXT(ERRORS,TEXT) ;
- I $L($G(TEXT)),$L($G(TEXT))<2 D ERRLOG^SDESJSON(.ERRORS,64)
- Q
- VALIDATEEAS(ERRORS,SDEAS) ;
- I $L(SDEAS) S SDEAS=$$EASVALIDATE^SDESUTIL($G(SDEAS))
- I $P($G(SDEAS),U)=-1 D ERRLOG^SDESJSON(.ERRORS,142)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESGETLETTERS 3488 printed Feb 19, 2025@00:23:27 Page 2
- SDESGETLETTERS ;ALB/BWF - VISTA SCHEDULING RPCS ;JUNE 10, 2022
- +1 ;;5.3;Scheduling;**819**;Aug 13, 1993;Build 5
- +2 ;;Per VHA Directive 6402, this routine should not be modified
- +3 ;
- +4 QUIT
- +5 ; return letter types for the LETTER TYPE file (#407.6)
- GETLETTERTYPES(RES,EAS) ;
- +1 NEW X,LCNT,LETARRY,ERR
- +2 DO VALIDATEEAS(.ERR,$GET(EAS))
- +3 IF $DATA(ERR)
- Begin DoDot:1
- +4 SET ERR("LetterType",1)=""
- +5 DO BUILDJSON^SDESBUILDJSON(.RES,.ERR)
- End DoDot:1
- QUIT
- +6 SET X=0
- +7 FOR
- SET X=$ORDER(^VA(407.6,X))
- if 'X
- QUIT
- Begin DoDot:1
- +8 SET LCNT=$GET(LCNT)+1
- +9 SET LETARRY("LetterType",LCNT,"Type")=$$GET1^DIQ(407.6,X,.01,"E")
- +10 SET LETARRY("LetterType",LCNT,"Name")=$$GET1^DIQ(407.6,X,1,"E")
- End DoDot:1
- +11 IF '$DATA(LETARRY)
- SET LETARRY("LetterType",1)=""
- +12 DO BUILDJSON^SDESBUILDJSON(.RES,.LETARRY)
- +13 QUIT
- +14 ; 407.5 - LETTER
- +15 ; 407.6 - LETTER TYPE
- +16 ; 403.52 - RECALL REMINDERS LETTERS
- +17 ; get a list of all letters ,full text
- +18 ; TYPE - type of letter (N - NO show, A - Appointment Cancellation, P - PreAppointment Cancellation, C - Clinic Cancelled)
- +19 ; TEXT - (optional) text to match
- +20 ; BRIEF - 1 for brief data return (no letter text), 0 or "" for full letter/letter text
- GETLETTERSBYTYPE(RES,TYPE,TEXT,BRIEF,EAS) ;
- +1 NEW LETIEN,LCNT,LETARRY,F,ERR
- +2 SET F=407.5
- +3 DO VALLETTERTYPE(.ERR,TYPE)
- +4 DO VALLETTERTEXT(.ERR,TEXT)
- +5 DO VALIDATEEAS(.ERR,$GET(EAS))
- +6 IF $DATA(ERR)
- Begin DoDot:1
- +7 SET ERR("Letter",1)=""
- +8 DO BUILDJSON^SDESBUILDJSON(.RES,.ERR)
- QUIT
- End DoDot:1
- QUIT
- +9 SET (LETIEN,LCNT)=0
- +10 FOR
- SET LETIEN=$ORDER(^VA(F,"C",TYPE,LETIEN))
- if 'LETIEN
- QUIT
- Begin DoDot:1
- +11 IF $LENGTH($GET(TEXT))
- IF $EXTRACT($$GET1^DIQ(F,LETIEN,.01,"E"),1,$LENGTH(TEXT))'=TEXT
- QUIT
- +12 DO BUILDLETTER(.LETARRY,LETIEN,.LCNT,$GET(BRIEF))
- End DoDot:1
- +13 IF '$DATA(LETARRY)
- SET LETARRY("Letter",1)=""
- +14 DO BUILDJSON^SDESBUILDJSON(.RES,.LETARRY)
- +15 QUIT
- +16 ;
- GETLETTERBYIEN(RES,IEN,EAS) ;
- +1 NEW ERR,LETARRY,CNT
- +2 DO VALLETTERIEN(.ERR,IEN)
- +3 DO VALIDATEEAS(.ERR,$GET(EAS))
- +4 IF $DATA(ERR)
- Begin DoDot:1
- +5 SET ERR("Letter",1)=""
- +6 DO BUILDJSON^SDESBUILDJSON(.RES,.ERR)
- QUIT
- End DoDot:1
- QUIT
- +7 SET CNT=$GET(CNT)+1
- +8 DO BUILDLETTER(.LETARRY,IEN,.CNT)
- +9 IF '$DATA(LETARRY)
- SET LETARRY("Letter",1)=""
- +10 DO BUILDJSON^SDESBUILDJSON(.RES,.LETARRY)
- +11 QUIT
- +12 ; BRIEF - indicates a brief list, without the letter text
- BUILDLETTER(LETARRY,IEN,LCNT,BRIEF) ;
- +1 NEW LETDATA,LIENS,LETDATA,INITSEC,FINSEC,LIENS,F,LETTERIEN,LETTERTYPE
- +2 SET F=407.5
- +3 SET LCNT=$GET(LCNT)+1
- +4 SET LIENS=IEN_","
- +5 DO GETS^DIQ(F,IEN_",","**","IE","LETDATA")
- +6 SET LETARRY("Letter",LCNT,"ID")=IEN
- +7 SET LETARRY("Letter",LCNT,"Name")=$GET(LETDATA(F,LIENS,.01,"E"))
- +8 SET TYPE=$$GET1^DIQ(407.5,IEN,1,"E")
- +9 SET LETTERIEN=$ORDER(^VA(407.6,"B",TYPE,0))
- +10 SET LETTERTYPE=$$GET1^DIQ(407.6,LETTERIEN,1,"E")
- +11 SET LETARRY("Letter",LCNT,"Type")=LETTERTYPE
- +12 if $GET(BRIEF)
- QUIT
- +13 SET LETARRY("Letter",LCNT,"PrintDefaultProvider")=$GET(LETDATA(F,LIENS,4,"E"))
- +14 SET LETARRY("Letter",LCNT,"PrintClinicLocation")=$GET(LETDATA(F,LIENS,5,"E"))
- +15 SET INITSEC=0
- +16 FOR
- SET INITSEC=$ORDER(LETDATA(F,LIENS,2,INITSEC))
- if 'INITSEC
- QUIT
- Begin DoDot:1
- +17 SET LETARRY("Letter",LCNT,"InitialSection",INITSEC)=$GET(LETDATA(F,LIENS,2,INITSEC))
- End DoDot:1
- +18 SET FINSEC=0
- +19 FOR
- SET FINSEC=$ORDER(LETDATA(F,LIENS,3,FINSEC))
- if 'FINSEC
- QUIT
- Begin DoDot:1
- +20 SET LETARRY("Letter",LCNT,"FinalSection",FINSEC)=$GET(LETDATA(F,LIENS,3,FINSEC))
- End DoDot:1
- +21 QUIT
- VALLETTERIEN(ERRORS,IEN) ;
- +1 IF '$LENGTH($GET(IEN))
- DO ERRLOG^SDESJSON(.ERRORS,227)
- QUIT
- +2 IF '$DATA(^VA(407.5,IEN))
- DO ERRLOG^SDESJSON(.ERRORS,225)
- +3 QUIT
- VALLETTERTYPE(ERRORS,TYPE) ;
- +1 IF '$LENGTH($GET(TYPE))
- DO ERRLOG^SDESJSON(.ERRORS,228)
- QUIT
- +2 IF '$DATA(^VA(407.5,"C",TYPE))
- DO ERRLOG^SDESJSON(.ERRORS,226)
- +3 QUIT
- VALLETTERTEXT(ERRORS,TEXT) ;
- +1 IF $LENGTH($GET(TEXT))
- IF $LENGTH($GET(TEXT))<2
- DO ERRLOG^SDESJSON(.ERRORS,64)
- +2 QUIT
- VALIDATEEAS(ERRORS,SDEAS) ;
- +1 IF $LENGTH(SDEAS)
- SET SDEAS=$$EASVALIDATE^SDESUTIL($GET(SDEAS))
- +2 IF $PIECE($GET(SDEAS),U)=-1
- DO ERRLOG^SDESJSON(.ERRORS,142)
- +3 QUIT