- SDEC01B ;ALB/SAT - VISTA SCHEDULING RPCS ;APR 08, 2016
- ;;5.3;Scheduling;**627,642,722**;Aug 13, 1993;Build 26
- ;
- Q
- ;
- RESDG(SDRES) ;remove SDEC RESOURCE from all SDEC RESOURCE GROUPs
- N SDECY,SDI,SDJ
- S SDECY=""
- S SDRES=$G(SDRES) Q:'+SDRES Q:'$D(^SDEC(409.831,+SDRES,0))
- S SDI=9999999 F S SDI=$O(^SDEC(409.832,"AB",+SDRES,SDI),-1) Q:SDI="" D
- .D DELRGI^SDEC(.SDECY,SDI,SDRES)
- Q
- ;
- RESDGA ;remove all inactive SDEC RESOURCEs from all SDEC RESOURCE GROUPs
- N SDI,X
- S SDI=0 F S SDI=$O(^SDEC(409.831,SDI)) Q:SDI'>0 S X=$$GET1^DIQ(409.831,SDI_",",.02)="YES" ;computed routine calls RESDG
- Q
- ;
- RESCK(SDRES) ;check if SDEC RESOURCE is inactive ;remove from all SDEC RESOURCE GROUPs if inactive
- N X
- S SDRES=$G(SDRES) Q:'+SDRES Q:'$D(^SDEC(409.831,+SDRES,0))
- S X=$$GET1^DIQ(409.831,SDRES_",",.02)="YES" ;computed routines calls RESDG
- Q
- ;
- USRDG(SDDUZ) ;remove SDEC RESOURCEs associated with SDDUZ from all SDEC RESOURCE GROUPs
- ; SDDUZ = pointer to NEW PERSON file 200
- N SDRES
- S SDRES=0 F S SDRES=$O(^SDEC(409.831,"AC","P",SDDUZ,SDRES)) Q:SDRES="" D
- .D RESDG(SDRES)
- Q
- ;
- ;
- RESPRV1(SDPRV,SDCL,SDPRVN) ;process 1 provider
- N EFFDT,EXPDT,PACT,SDFDA,SDIEN,SDMSG,SDRES
- ;look for existing resource
- S (EFFDT,EXPDT)=""
- S SDCL=$G(SDCL) Q:'$D(^SC(+SDCL,0))
- S SDPRV=$G(SDPRV) Q:'$D(^VA(200,+SDPRV,0))
- S SDPRVN=$G(SDPRVN) S:SDPRVN="" SDPRVN=$$GET1^DIQ(200,SDPRV_",",.01)
- S SDRES=$O(^SDEC(409.831,"AC","P",SDPRV,0))
- I SDRES'="",$$CHKP(SDPRV,SDRES) Q ;if entry found, update and quit
- ;S SDRES=$O(^SDEC(409.831,"B",SDPRVN,0)) ;look for existing SDEC RESOURCE id with provider name
- ;I SDRES'="",$$CHKP(SDPRV,SDRES) Q ;if entry found, update and quit
- S SDRES="+1"
- S PACT=$$PC^SDEC45(SDPRV,DT,.EFFDT,.EXPDT)
- S:EXPDT="" EXPDT=DT
- ;
- K SDFDA,SDIEN,SDMSG
- S SDFDA=$NA(SDFDA(409.831,SDRES_","))
- S @SDFDA@(.01)=SDPRVN
- S @SDFDA@(.012)=SDPRV_";VA(200,"
- S @SDFDA@(.015)=$E($$NOW^XLFDT,1,12)
- S @SDFDA@(.016)=DUZ
- S:+PACT @SDFDA@(.021)=EXPDT
- S @SDFDA@(.04)=SDCL
- D UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
- S SDRES=SDIEN(1)
- Q
- CHKP(USER,SDRES) ;update existing provider resource entry
- ;returns 0=SDRES does not match USER ;1=matches and updated
- N EFFDT,EXPDT,RACT,PACT,RSN,RSTS,RSTYP,SDFDA,SCN,SDNOD,SCTS
- S RSTYP=$$GET1^DIQ(409.831,SDRES_",",.012,"I")
- Q:$P(RSTYP,";",1)'=USER 0
- ;
- S SCN=$$GET1^DIQ(200,USER_",",.01)
- S RSN=$$GET1^DIQ(409.831,SDRES_",",.01)
- S:SCN'=RSN SDFDA(409.831,SDRES_",",.01)=SCN
- ;
- S (EFFDT,EXPDT)=""
- S RACT=$$GET1^DIQ(409.831,SDRES_",",.02) S RACT=$S(RACT="YES":1,1:0)
- S PACT=$$PC^SDEC45(USER,DT,.EFFDT,.EXPDT)
- I RACT'=PACT D
- .S SDNOD=$G(^SDEC(409.831,SDRES,0))
- .I PACT=0 S SDFDA(409.831,SDRES_",",.021)="@",SDFDA(409.831,SDRES_",",.025)="@"
- .E S SDFDA(409.831,SDRES_",",.021)=$S(EXPDT="":$$FMADD^XLFDT(DT,-1),EXPDT'>DT:EXPDT,1:$$FMADD^XLFDT(DT,-1)),SDFDA(409.831,SDRES_",",.025)="@"
- ;
- I $D(SDFDA) D UPDATE^DIE("","SDFDA")
- D:+PACT RESCK(SDRES)
- Q 1
- ;
- CHKC(SDCL,SDRES) ;update existing clinic resource entry
- Q ; 722 disabled to stop changing the resource file wtc 2/22/19
- N CINACT,CREACT,RINACT,RREACT,RSN,RSTS,RSTYP,SDFDA,SCN,SCTS
- S RSTYP=$$GET1^DIQ(409.831,SDRES_",",.012,"I")
- Q:$P(RSTYP,";",1)'=SDCL
- ;
- S SCN=$$GET1^DIQ(44,SDCL_",",.01)
- S RSN=$$GET1^DIQ(409.831,SDRES_",",.01)
- S:SCN'=RSN SDFDA(409.831,SDRES_",",.01)=SCN
- ;
- S CINACT=$$GET1^DIQ(44,SDCL_",",2505,"I")
- S RINACT=$$GET1^DIQ(409.831,SDRES_",",.021,"I")
- S:CINACT'=RINACT SDFDA(409.831,SDRES_",",.021)=CINACT,SDFDA(409.831,SDRES_",",.022)="@"
- S CREACT=$$GET1^DIQ(44,SDCL_",",2506,"I")
- S RREACT=$$GET1^DIQ(409.831,SDRES_",",.025)
- S:CREACT'=RREACT SDFDA(409.831,SDRES_",",.025)=CREACT,SDFDA(409.831,SDRES_",",.026)="@"
- ;
- S SCTS=$$GET1^DIQ(44,SDCL_",",1917,"I") S SCTS=$S(SCTS=6:10,SCTS=4:15,SCTS=3:20,SCTS=2:30,1:60)
- S RSTS=$$GET1^DIQ(409.831,SDRES_",",.03,"I")
- S:SCTS'=RSTS SDFDA(409.831,SDRES_",",.03)=SCTS ;time scale
- ;
- I $D(SDFDA) D UPDATE^DIE("","SDFDA")
- Q
- ;
- RESCLIN1(SDCL) ;
- N SDCLN,SDDATA,SDFDA,SDFIELDS,SDFOUND,SDIEN,SDIN,SDLET,SDMSG,SDRES11,SDRESH,SDRN,SDMSG,SDTS,SDWP
- S SDFOUND=0
- ; .01 name; 2 type; 1912 len of appt; 2508 no show let; 2509 pre-appt let; 2510 clinic can let;
- S SDFIELDS=".01;2;50.01;1912;1917;2505;2506;2508;2509;2510"
- D GETS^DIQ(44,SDCL_",",SDFIELDS,"IE","SDDATA","SDMSG")
- I SDDATA(44,SDCL_",",2,"I")="C" D
- .;Q:SDDATA(44,SDCL_",",50.01,"I")=1 ;OOS?
- .S SDIN=SDDATA(44,SDCL_",",2505,"I"),SDRN=SDDATA(44,SDCL_",",2506,"I")
- .Q:$$INACT(SDIN,SDRN)
- .S SDCLN=SDDATA(44,SDCL_",",.01,"E") ;clinic name
- .;look for existing to allow this post-init to be re-entrant
- .S SDRESH=0 F S SDRESH=$O(^SDEC(409.831,"ALOC",SDCL,SDRESH)) Q:SDRESH'>0 D Q:+SDFOUND
- ..S SDRES11=$$GET1^DIQ(409.831,SDRESH_",",.012,"I")
- ..I $P(SDRES11,";",2)="SC(",$P(SDRES11,";",1)=SDCL S SDFOUND=1
- .I +SDFOUND D CHKC(SDCL,SDRESH) Q
- .S SDRESH=$O(^SDEC(409.831,"B",$$UP^XLFSTR(SDCLN),0)) ;look for existing SDEC RESOURCE id with clinic name
- .I SDRESH'="" Q
- .S SDRESH="+1"
- .K SDFDA,SDIEN,SDMSG
- .S SDFDA=$NA(SDFDA(409.831,SDRESH_","))
- .S @SDFDA@(.01)=SDCLN
- .S @SDFDA@(.012)=SDCL_";SC("
- .S @SDFDA@(.015)=$E($$NOW^XLFDT,1,12)
- .S @SDFDA@(.016)=DUZ
- .I SDDATA(44,SDCL_",",2505,"I")'="" S @SDFDA@(.021)=SDDATA(44,SDCL_",",2505,"I")
- .I SDDATA(44,SDCL_",",2506,"I")'="" S @SDFDA@(.025)=SDDATA(44,SDCL_",",2506,"I")
- .S SDTS=SDDATA(44,SDCL_",",1917,"I") S @SDFDA@(.03)=$S(SDTS=5:5,SDTS=6:10,SDTS=4:15,SDTS=3:20,SDTS=2:30,SDTS=45:15,1:60) ;time scale
- .S @SDFDA@(.04)=SDCL
- .D UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
- .I $D(SDMSG) W !,"RESCLIN: Unable to store clinic "_SDCL_" in resource." Q
- .S SDRESH=SDIEN(1)
- .;get letter text
- .S SDLET=SDDATA(44,SDCL_",",2509,"I")
- .D RESLET(SDLET,.SDWP)
- .I $D(SDWP) D WP^DIE(409.831,SDRESH_",",1,"","SDWP")
- .;get no show letter
- .S SDLET=SDDATA(44,SDCL_",",2508,"I")
- .D RESLET(SDLET,.SDWP)
- .I $D(SDWP) D WP^DIE(409.831,SDRESH_",",1201,"","SDWP")
- .;get clinic cancellation letter
- .S SDLET=SDDATA(44,SDCL_",",2510,"I")
- .D RESLET(SDLET,.SDWP)
- .I $D(SDWP) D WP^DIE(409.831,SDRESH_",",1301,"","SDWP")
- Q
- RESLET(SDLET,SDWP) ;get letter text
- ;INPUT:
- ; SDLET - Letter ID pointer to LETTER file 407.5
- ;RETURN
- ; .SDWP - Word Processor array used to store text using WP^DIE
- N SDMSG,SDWPI,SDWPJ,SDWP2,SDWP3,X
- S X=$$GET1^DIQ(407.5,SDLET_",",2,"","SDWP2","SDMSG")
- Q:$D(SDMSG)
- S X=$$GET1^DIQ(407.5,SDLET_",",3,"","SDWP3","SDMSG")
- S SDWPI=0
- S SDWPJ="" F S SDWPJ=$O(SDWP2(SDWPJ)) Q:SDWPJ="" S SDWPI=SDWPI+1 S SDWP(SDWPI)=SDWP2(SDWPJ)
- S SDWPJ="" F S SDWPJ=$O(SDWP3(SDWPJ)) Q:SDWPJ="" S SDWPI=SDWPI+1 S SDWP(SDWPI)=SDWP3(SDWPJ)
- Q
- INACT(SDIN,SDRN) ;
- ;0=ACTIVATE
- ;1=INACTIVE
- N NOW,RET
- S RET=0
- S NOW=$P($$NOW^XLFDT,".",1)
- S SDIN=$P($G(SDIN),".",1)
- S SDRN=$P($G(SDRN),".",1)
- Q:SDIN="" 0 ;no inactive date
- Q:NOW<SDIN 0 ;inactive date still in future
- I SDIN'>NOW D
- .;MGH added one more check on dates
- .S RET=$S(SDRN="":1,SDRN'>NOW:0,SDRN>SDIN:0,1:1)
- Q RET
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC01B 7039 printed Jan 18, 2025@03:50:58 Page 2
- SDEC01B ;ALB/SAT - VISTA SCHEDULING RPCS ;APR 08, 2016
- +1 ;;5.3;Scheduling;**627,642,722**;Aug 13, 1993;Build 26
- +2 ;
- +3 QUIT
- +4 ;
- RESDG(SDRES) ;remove SDEC RESOURCE from all SDEC RESOURCE GROUPs
- +1 NEW SDECY,SDI,SDJ
- +2 SET SDECY=""
- +3 SET SDRES=$GET(SDRES)
- if '+SDRES
- QUIT
- if '$DATA(^SDEC(409.831,+SDRES,0))
- QUIT
- +4 SET SDI=9999999
- FOR
- SET SDI=$ORDER(^SDEC(409.832,"AB",+SDRES,SDI),-1)
- if SDI=""
- QUIT
- Begin DoDot:1
- +5 DO DELRGI^SDEC(.SDECY,SDI,SDRES)
- End DoDot:1
- +6 QUIT
- +7 ;
- RESDGA ;remove all inactive SDEC RESOURCEs from all SDEC RESOURCE GROUPs
- +1 NEW SDI,X
- +2 ;computed routine calls RESDG
- SET SDI=0
- FOR
- SET SDI=$ORDER(^SDEC(409.831,SDI))
- if SDI'>0
- QUIT
- SET X=$$GET1^DIQ(409.831,SDI_",",.02)="YES"
- +3 QUIT
- +4 ;
- RESCK(SDRES) ;check if SDEC RESOURCE is inactive ;remove from all SDEC RESOURCE GROUPs if inactive
- +1 NEW X
- +2 SET SDRES=$GET(SDRES)
- if '+SDRES
- QUIT
- if '$DATA(^SDEC(409.831,+SDRES,0))
- QUIT
- +3 ;computed routines calls RESDG
- SET X=$$GET1^DIQ(409.831,SDRES_",",.02)="YES"
- +4 QUIT
- +5 ;
- USRDG(SDDUZ) ;remove SDEC RESOURCEs associated with SDDUZ from all SDEC RESOURCE GROUPs
- +1 ; SDDUZ = pointer to NEW PERSON file 200
- +2 NEW SDRES
- +3 SET SDRES=0
- FOR
- SET SDRES=$ORDER(^SDEC(409.831,"AC","P",SDDUZ,SDRES))
- if SDRES=""
- QUIT
- Begin DoDot:1
- +4 DO RESDG(SDRES)
- End DoDot:1
- +5 QUIT
- +6 ;
- +7 ;
- RESPRV1(SDPRV,SDCL,SDPRVN) ;process 1 provider
- +1 NEW EFFDT,EXPDT,PACT,SDFDA,SDIEN,SDMSG,SDRES
- +2 ;look for existing resource
- +3 SET (EFFDT,EXPDT)=""
- +4 SET SDCL=$GET(SDCL)
- if '$DATA(^SC(+SDCL,0))
- QUIT
- +5 SET SDPRV=$GET(SDPRV)
- if '$DATA(^VA(200,+SDPRV,0))
- QUIT
- +6 SET SDPRVN=$GET(SDPRVN)
- if SDPRVN=""
- SET SDPRVN=$$GET1^DIQ(200,SDPRV_",",.01)
- +7 SET SDRES=$ORDER(^SDEC(409.831,"AC","P",SDPRV,0))
- +8 ;if entry found, update and quit
- IF SDRES'=""
- IF $$CHKP(SDPRV,SDRES)
- QUIT
- +9 ;S SDRES=$O(^SDEC(409.831,"B",SDPRVN,0)) ;look for existing SDEC RESOURCE id with provider name
- +10 ;I SDRES'="",$$CHKP(SDPRV,SDRES) Q ;if entry found, update and quit
- +11 SET SDRES="+1"
- +12 SET PACT=$$PC^SDEC45(SDPRV,DT,.EFFDT,.EXPDT)
- +13 if EXPDT=""
- SET EXPDT=DT
- +14 ;
- +15 KILL SDFDA,SDIEN,SDMSG
- +16 SET SDFDA=$NAME(SDFDA(409.831,SDRES_","))
- +17 SET @SDFDA@(.01)=SDPRVN
- +18 SET @SDFDA@(.012)=SDPRV_";VA(200,"
- +19 SET @SDFDA@(.015)=$EXTRACT($$NOW^XLFDT,1,12)
- +20 SET @SDFDA@(.016)=DUZ
- +21 if +PACT
- SET @SDFDA@(.021)=EXPDT
- +22 SET @SDFDA@(.04)=SDCL
- +23 DO UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
- +24 SET SDRES=SDIEN(1)
- +25 QUIT
- CHKP(USER,SDRES) ;update existing provider resource entry
- +1 ;returns 0=SDRES does not match USER ;1=matches and updated
- +2 NEW EFFDT,EXPDT,RACT,PACT,RSN,RSTS,RSTYP,SDFDA,SCN,SDNOD,SCTS
- +3 SET RSTYP=$$GET1^DIQ(409.831,SDRES_",",.012,"I")
- +4 if $PIECE(RSTYP,";",1)'=USER
- QUIT 0
- +5 ;
- +6 SET SCN=$$GET1^DIQ(200,USER_",",.01)
- +7 SET RSN=$$GET1^DIQ(409.831,SDRES_",",.01)
- +8 if SCN'=RSN
- SET SDFDA(409.831,SDRES_",",.01)=SCN
- +9 ;
- +10 SET (EFFDT,EXPDT)=""
- +11 SET RACT=$$GET1^DIQ(409.831,SDRES_",",.02)
- SET RACT=$SELECT(RACT="YES":1,1:0)
- +12 SET PACT=$$PC^SDEC45(USER,DT,.EFFDT,.EXPDT)
- +13 IF RACT'=PACT
- Begin DoDot:1
- +14 SET SDNOD=$GET(^SDEC(409.831,SDRES,0))
- +15 IF PACT=0
- SET SDFDA(409.831,SDRES_",",.021)="@"
- SET SDFDA(409.831,SDRES_",",.025)="@"
- +16 IF '$TEST
- SET SDFDA(409.831,SDRES_",",.021)=$SELECT(EXPDT="":$$FMADD^XLFDT(DT,-1),EXPDT'>DT:EXPDT,1:$$FMADD^XLFDT(DT,-1))
- SET SDFDA(409.831,SDRES_",",.025)="@"
- End DoDot:1
- +17 ;
- +18 IF $DATA(SDFDA)
- DO UPDATE^DIE("","SDFDA")
- +19 if +PACT
- DO RESCK(SDRES)
- +20 QUIT 1
- +21 ;
- CHKC(SDCL,SDRES) ;update existing clinic resource entry
- +1 ; 722 disabled to stop changing the resource file wtc 2/22/19
- QUIT
- +2 NEW CINACT,CREACT,RINACT,RREACT,RSN,RSTS,RSTYP,SDFDA,SCN,SCTS
- +3 SET RSTYP=$$GET1^DIQ(409.831,SDRES_",",.012,"I")
- +4 if $PIECE(RSTYP,";",1)'=SDCL
- QUIT
- +5 ;
- +6 SET SCN=$$GET1^DIQ(44,SDCL_",",.01)
- +7 SET RSN=$$GET1^DIQ(409.831,SDRES_",",.01)
- +8 if SCN'=RSN
- SET SDFDA(409.831,SDRES_",",.01)=SCN
- +9 ;
- +10 SET CINACT=$$GET1^DIQ(44,SDCL_",",2505,"I")
- +11 SET RINACT=$$GET1^DIQ(409.831,SDRES_",",.021,"I")
- +12 if CINACT'=RINACT
- SET SDFDA(409.831,SDRES_",",.021)=CINACT
- SET SDFDA(409.831,SDRES_",",.022)="@"
- +13 SET CREACT=$$GET1^DIQ(44,SDCL_",",2506,"I")
- +14 SET RREACT=$$GET1^DIQ(409.831,SDRES_",",.025)
- +15 if CREACT'=RREACT
- SET SDFDA(409.831,SDRES_",",.025)=CREACT
- SET SDFDA(409.831,SDRES_",",.026)="@"
- +16 ;
- +17 SET SCTS=$$GET1^DIQ(44,SDCL_",",1917,"I")
- SET SCTS=$SELECT(SCTS=6:10,SCTS=4:15,SCTS=3:20,SCTS=2:30,1:60)
- +18 SET RSTS=$$GET1^DIQ(409.831,SDRES_",",.03,"I")
- +19 ;time scale
- if SCTS'=RSTS
- SET SDFDA(409.831,SDRES_",",.03)=SCTS
- +20 ;
- +21 IF $DATA(SDFDA)
- DO UPDATE^DIE("","SDFDA")
- +22 QUIT
- +23 ;
- RESCLIN1(SDCL) ;
- +1 NEW SDCLN,SDDATA,SDFDA,SDFIELDS,SDFOUND,SDIEN,SDIN,SDLET,SDMSG,SDRES11,SDRESH,SDRN,SDMSG,SDTS,SDWP
- +2 SET SDFOUND=0
- +3 ; .01 name; 2 type; 1912 len of appt; 2508 no show let; 2509 pre-appt let; 2510 clinic can let;
- +4 SET SDFIELDS=".01;2;50.01;1912;1917;2505;2506;2508;2509;2510"
- +5 DO GETS^DIQ(44,SDCL_",",SDFIELDS,"IE","SDDATA","SDMSG")
- +6 IF SDDATA(44,SDCL_",",2,"I")="C"
- Begin DoDot:1
- +7 ;Q:SDDATA(44,SDCL_",",50.01,"I")=1 ;OOS?
- +8 SET SDIN=SDDATA(44,SDCL_",",2505,"I")
- SET SDRN=SDDATA(44,SDCL_",",2506,"I")
- +9 if $$INACT(SDIN,SDRN)
- QUIT
- +10 ;clinic name
- SET SDCLN=SDDATA(44,SDCL_",",.01,"E")
- +11 ;look for existing to allow this post-init to be re-entrant
- +12 SET SDRESH=0
- FOR
- SET SDRESH=$ORDER(^SDEC(409.831,"ALOC",SDCL,SDRESH))
- if SDRESH'>0
- QUIT
- Begin DoDot:2
- +13 SET SDRES11=$$GET1^DIQ(409.831,SDRESH_",",.012,"I")
- +14 IF $PIECE(SDRES11,";",2)="SC("
- IF $PIECE(SDRES11,";",1)=SDCL
- SET SDFOUND=1
- End DoDot:2
- if +SDFOUND
- QUIT
- +15 IF +SDFOUND
- DO CHKC(SDCL,SDRESH)
- QUIT
- +16 ;look for existing SDEC RESOURCE id with clinic name
- SET SDRESH=$ORDER(^SDEC(409.831,"B",$$UP^XLFSTR(SDCLN),0))
- +17 IF SDRESH'=""
- QUIT
- +18 SET SDRESH="+1"
- +19 KILL SDFDA,SDIEN,SDMSG
- +20 SET SDFDA=$NAME(SDFDA(409.831,SDRESH_","))
- +21 SET @SDFDA@(.01)=SDCLN
- +22 SET @SDFDA@(.012)=SDCL_";SC("
- +23 SET @SDFDA@(.015)=$EXTRACT($$NOW^XLFDT,1,12)
- +24 SET @SDFDA@(.016)=DUZ
- +25 IF SDDATA(44,SDCL_",",2505,"I")'=""
- SET @SDFDA@(.021)=SDDATA(44,SDCL_",",2505,"I")
- +26 IF SDDATA(44,SDCL_",",2506,"I")'=""
- SET @SDFDA@(.025)=SDDATA(44,SDCL_",",2506,"I")
- +27 ;time scale
- SET SDTS=SDDATA(44,SDCL_",",1917,"I")
- SET @SDFDA@(.03)=$SELECT(SDTS=5:5,SDTS=6:10,SDTS=4:15,SDTS=3:20,SDTS=2:30,SDTS=45:15,1:60)
- +28 SET @SDFDA@(.04)=SDCL
- +29 DO UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
- +30 IF $DATA(SDMSG)
- WRITE !,"RESCLIN: Unable to store clinic "_SDCL_" in resource."
- QUIT
- +31 SET SDRESH=SDIEN(1)
- +32 ;get letter text
- +33 SET SDLET=SDDATA(44,SDCL_",",2509,"I")
- +34 DO RESLET(SDLET,.SDWP)
- +35 IF $DATA(SDWP)
- DO WP^DIE(409.831,SDRESH_",",1,"","SDWP")
- +36 ;get no show letter
- +37 SET SDLET=SDDATA(44,SDCL_",",2508,"I")
- +38 DO RESLET(SDLET,.SDWP)
- +39 IF $DATA(SDWP)
- DO WP^DIE(409.831,SDRESH_",",1201,"","SDWP")
- +40 ;get clinic cancellation letter
- +41 SET SDLET=SDDATA(44,SDCL_",",2510,"I")
- +42 DO RESLET(SDLET,.SDWP)
- +43 IF $DATA(SDWP)
- DO WP^DIE(409.831,SDRESH_",",1301,"","SDWP")
- End DoDot:1
- +44 QUIT
- RESLET(SDLET,SDWP) ;get letter text
- +1 ;INPUT:
- +2 ; SDLET - Letter ID pointer to LETTER file 407.5
- +3 ;RETURN
- +4 ; .SDWP - Word Processor array used to store text using WP^DIE
- +5 NEW SDMSG,SDWPI,SDWPJ,SDWP2,SDWP3,X
- +6 SET X=$$GET1^DIQ(407.5,SDLET_",",2,"","SDWP2","SDMSG")
- +7 if $DATA(SDMSG)
- QUIT
- +8 SET X=$$GET1^DIQ(407.5,SDLET_",",3,"","SDWP3","SDMSG")
- +9 SET SDWPI=0
- +10 SET SDWPJ=""
- FOR
- SET SDWPJ=$ORDER(SDWP2(SDWPJ))
- if SDWPJ=""
- QUIT
- SET SDWPI=SDWPI+1
- SET SDWP(SDWPI)=SDWP2(SDWPJ)
- +11 SET SDWPJ=""
- FOR
- SET SDWPJ=$ORDER(SDWP3(SDWPJ))
- if SDWPJ=""
- QUIT
- SET SDWPI=SDWPI+1
- SET SDWP(SDWPI)=SDWP3(SDWPJ)
- +12 QUIT
- INACT(SDIN,SDRN) ;
- +1 ;0=ACTIVATE
- +2 ;1=INACTIVE
- +3 NEW NOW,RET
- +4 SET RET=0
- +5 SET NOW=$PIECE($$NOW^XLFDT,".",1)
- +6 SET SDIN=$PIECE($GET(SDIN),".",1)
- +7 SET SDRN=$PIECE($GET(SDRN),".",1)
- +8 ;no inactive date
- if SDIN=""
- QUIT 0
- +9 ;inactive date still in future
- if NOW<SDIN
- QUIT 0
- +10 IF SDIN'>NOW
- Begin DoDot:1
- +11 ;MGH added one more check on dates
- +12 SET RET=$SELECT(SDRN="":1,SDRN'>NOW:0,SDRN>SDIN:0,1:1)
- End DoDot:1
- +13 QUIT RET