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 Apr 09, 2024@21:53: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
