YSCLDIS ;HINOI/RTW,HEC/HRUBOVCAK - DISCONTINUE CLOZAPINE PATIENT STATUS ; Jun 12, 2023@17:11
;;5.01;MENTAL HEALTH;**122,154,227**;Dec 30, 1994;Build 17
;
Q
; Reference to ^DPT supported by IA #10035
; Reference to ^PS(55 supported by IA #787
; Reference to $$SITE^VASITE supported by IA #10112
; Reference to ^DIC supported by DBIA #2051
; Reference to ^DIE supported by DBIA #2053
; Reference to ^DIQ supported by DBIA #2056
; Reference to ^XLFDT supported by DBIA #10103
; Reference to ^XMD supported by DBIA #10070
; Reference to ^%DTC supported by DBIA #10000
;
;This routine will loop through ^PS(55,DFN,"ASAND" and check the last prescription
; end date and/or the Inpatient Order stop date. If the patient has not had an active
; prescription or Inpatent Clozapine Order in the last 56 days, the Active Treatment will STOP
; YSCLPT("dataFound?") is true if reason found to NOT discontinue the patient
; routine rewritten for YS*5.01*154 - 27 September 2019
; OPT and IPT subroutines rewritten to use Pharmacy APIs for YS*5.01*227 - 20 June 2023
;
START ; called from XMIT^YSCLTST5
D DT^DICRW
; YSEND used in DMG^YSCLTST5
; YSPTDISC - patients discontinued this run
N DCONPD,DFN,X,Y,YSCLPT,YSEND,YSPTDISC,YSFMCLOZ,YSLN
; YS*5.01*227 - Change to use Fileman "parameter" field instead of hard-coded values
S DCONPD=$$GET1^DIQ(603.03,"1,",13)
S YSEND=$$FMADD^XLFDT(DT,366)
K ^TMP($J,"YSCLDATA") D XTMPZRO ; update ^XTMP("YSCLDIS",0)
D LIST^DIC(603.01,,1,"I",,,,,,,"YSFMCLOZ") ; 603.01,1 - CLOZAPINE PATIENT - 0;2 POINTER TO PATIENT FILE (#2)
;
F YSLN=1:1 Q:'$D(YSFMCLOZ("DILIST","ID",YSLN)) S DFN=YSFMCLOZ("DILIST","ID",YSLN,1) D:DFN
. K YSCLPT,^TMP($J,"YSCLDIS")
. ; YS*5.01*227 - Use Pharmacy APIs instead of direct Fileman calls per ICR
. ; (#53) CLOZAPINE REGISTRATION NUMBER [1F]
. D PSS^PSS781(DFN,,"YSCLDIS")
. S YSCLPT("reg#")=$G(^TMP($J,"YSCLDIS",DFN,53)) Q:YSCLPT("reg#")=""
. S YSCLPT("clozStatus")=$P($G(^TMP($J,"YSCLDIS",DFN,54)),U)
. Q:YSCLPT("clozStatus")="D" ;Not checking those already discontinued
. S YSCLPT("regDate")=$P($G(^TMP($J,"YSCLDIS",DFN,58)),U)
. S YSCLPT("numDays")=$$FMDIFF^XLFDT(DT,YSCLPT("regDate"))
. I YSCLPT("reg#")?1U6N D:YSCLPT("numDays")>4 Q ;temps greater than 4 days since registration
.. S YSCLPT("disconReason")=3 D SVPTINFO,DSCNPT,DMG^YSCLTST5
. ; YS*5.01*227 - Change to use Fileman parameter field instead of hard-coded 28-day value
. Q:YSCLPT("numDays")<DCONPD ;Not checking those registered 27 days or less
. S ^TMP($J,"YSCLDATA",DT,DFN)=YSCLPT("reg#")_U_YSCLPT("regDate"),YSCLPT("dataFound?")=0
. S YSCLPT("newReg?")=1 ;Registration is new unless clozapine orders are found
. D OPT Q:YSCLPT("dataFound?") ;Not checking further
. D INP Q:YSCLPT("dataFound?") ;
. S YSCLPT("disconReason")=$S(YSCLPT("newReg?"):1,1:2)
. D SVPTINFO,DSCNPT,DMG^YSCLTST5
;
D MSGTRNS
Q
OPT ; Outpatient orders
N I,YSSTDT,YSUNTDOS,YSCLOPT,YSCLRX,YSCLDRG,YSCLFLDT,YSCLSPDT,X,X1,X2,YSCLFLDA
; YS*5.01*227 - Rewrite to use Pharmacy APIs because ICR for Fileman reads is deprecated
S YSSTDT=$$FMADD^XLFDT(DT,-DCONPD)
D RX^PSO52API(DFN,"YSUNTDOS",,,"2",YSSTDT)
S I="A" F S I=$O(^TMP($J,"YSUNTDOS",DFN,I),-1) Q:'I D Q:YSCLPT("dataFound?")
. S YSCLRX=$G(^TMP($J,"YSUNTDOS",DFN,I,.01)),YSCLDRG=$P($G(^TMP($J,"YSUNTDOS",DFN,I,6)),U)
. ;Q:'$L($$GET1^DIQ(50,YSCLDRG,17.5)) ;'$D(^PSDRUG("ACLOZ",+YSCLDRG))
. D LAB^PSS50(YSCLDRG,,,,,"YSCLDRG")
. Q:'$L($G(^TMP($J,"YSCLDRG",YSCLDRG,17.5)))
. S YSCLFLDT=$P($G(^TMP($J,"YSUNTDOS",DFN,I,22)),U) Q:YSCLFLDT<YSCLPT("regDate")
. S YSCLPT("newReg?")=0 ; Registration isn't new
. S YSCLSPDT=$P($G(^TMP($J,"YSUNTDOS",DFN,I,26)),U)
. I YSCLSPDT'<DT S YSCLPT("dataFound?")=1 Q ; Not Expired yet
. S X1=DT,X2=YSCLFLDT D ^%DTC S YSCLFLDA=X
. ; YS*5.01*227 - Change to use Fileman parameter field instead of hard-coded value
. I YSCLFLDA<DCONPD S YSCLPT("dataFound?")=1
K ^TMP($J,"YSUNTDOS"),^TMP($J,"YSCLDRG")
Q
;
INP ;Inpatient Orders
; YSDSPDRG - DISPENSE DRUG (sub-file 55.07)
; YSUNTDOS - UNIT DOSE (sub-file 55.07)
N YSUNTDOS,YSDSPDRG,YSCLIPT,YSLINE,YSCLDRG,YSCLORDT,YSCLSPDT,YSCLORDA,X,X1,X2
; YS*5.01*227 - Rewrite to use Pharmacy APIs because ICR for Fileman reads is deprecated
D PSS431^PSS55(DFN,,,,"YSUNTDOS")
D PSS433^PSS55(DFN,"YSUNTDOS2")
S YSCLIPT="A" F S YSCLIPT=$O(^TMP($J,"YSUNTDOS",YSCLIPT),-1) Q:'YSCLIPT D Q:YSCLPT("dataFound?")
. S YSCLDRG=$O(^TMP($J,"YSUNTDOS",YSCLIPT,"DDRUG",0)) Q:'$G(YSCLDRG)
. S YSCLDRG=+$G(^TMP($J,"YSUNTDOS",YSCLIPT,"DDRUG",YSCLDRG,.01)) Q:'$G(YSCLDRG)
. ;Q:$$GET1^DIQ(50,YSCLDRG,17.5)'="PSOCLO1"
. D LAB^PSS50(YSCLDRG,,,,,"YSCLDRG")
. Q:$G(^TMP($J,"YSCLDRG",YSCLDRG,17.5))'="PSOCLO1"
. S YSCLORDT=+$G(^TMP($J,"YSUNTDOS",YSCLIPT,27)) Q:YSCLORDT<YSCLPT("regDate") ;Order date before Registration
. S YSCLPT("newReg?")=0 ; Registration not new
. S YSCLSPDT=+$G(^TMP($J,"YSUNTDOS2",YSCLIPT,34))
. I '(YSCLSPDT<DT) S YSCLPT("dataFound?")=1 Q ;Not Stopped yet
. S X1=DT,X2=YSCLORDT D ^%DTC S YSCLORDA=X
. ; YS*5.01*227 - Change to use Fileman parameter field instead of hard-coded value
. I YSCLORDA<DCONPD S YSCLPT("dataFound?")=1
K ^TMP($J,"YSUNTDOS"),^TMP($J,"YSUNTDOS2"),^TMP($J,"YSCLDRG")
Q
;
SVPTINFO ; save reason for discontinue
N J,C,N
; Change to use Fileman paremeter field instead of hard-coded discontinue period
S J=YSCLPT("disconReason"),C=$S(J=1!(J=2):DCONPD_" days",1:"temp # expired"),N=$$NOW^XLFDT
S ^XTMP("YSCLDIS",N,DFN,0)=J_U_C,YSPTDISC(DFN)=YSCLPT("disconReason")
S ^XTMP("YSCLDIS",N,DFN,"STATUS")=YSCLPT("clozStatus")
Q
;
DSCNPT ; discontinue patient in file #55
; ^DD(55,54,0) = 'CLOZAPINE STATUS^S'
; ^DD(55,56,0) = 'DEMOGRAPHICS SENT^S'
N DA,DIE,DR
S DIE="^PS(55,",DA=DFN,DR="54///D;56///1" D ^DIE
Q
;
MSGTRNS ; transmit message
N XMERR,YSBODY,YSFROM,YSITE,YSXMDUZ,YSXMINSTR,YSXMSUBJ,YSXMTO,YSXMZ
K ^TMP("XMERR",$J),^TMP($J,"YSCLXDISCMSG")
; ^DD(8989.3,501,0) 'PRODUCTION^RS^0:No;1:Yes' Forum for production
I $$GET1^DIQ(8989.3,1,501,"I") S YSXMTO("G.CLOZAPINE ROLL-UP@DOMAIN.EXT")=""
S YSXMTO("G.PSOCLOZ")="" ; always send locally
D YSXMTEXT
S YSXMINSTR("FROM")="CLOZAPINE MONITOR"
S Y=$$SITE^VASITE,YSXMSUBJ=$P(Y,U,2)_" ("_$P(Y,U,3)_") Discontinued Status"
S YSBODY=$NA(^TMP($J,"YSCLXDISCMSG"))
D SENDMSG^XMXAPI(DUZ,YSXMSUBJ,YSBODY,.YSXMTO,.YSXMINSTR,.YSXMZ)
I $G(YSXMZ)>0 S ^XTMP("YSCLDIS",0,"LAST MESSAGE SENT")=YSXMZ_U_$$NOW^XLFDT
D ; 603.03,6 - LAST DEMOGRAPHICS TRANSMISSION 0;6 DATE
. N DA,DIE,DR
. S DIE="^YSCL(603.03,",DA=1,DR="6///"_$$NOW^XLFDT D ^DIE
;
K ^TMP($J,"YSCLXDISCMSG")
;
Q
;
YSXMTEXT ; build message of discontinued clozapine patients data for NCC
; YS*5.01*227 - Change to use Fileman parameter field instead of hard-coded discontinue period
N J,YSCLRSN
S YSCLRSN(1,1)="The patient status has changed to 'Discontinued' because the new clozapine"
S YSCLRSN(1,2)="patient has not filled the prescription/order within "_DCONPD_" days of being"
S YSCLRSN(1,3)="marked 'Active'."
S YSCLRSN(2,1)="The patient status has changed to 'Discontinued' because the active clozapine"
S YSCLRSN(2,2)="patient has not filled the prescription/order within "_DCONPD_" days of"
S YSCLRSN(2,3)="being prescribed/ordered."
S YSCLRSN(3,1)="The patient status has changed to 'Discontinued' because the temporary local"
S YSCLRSN(3,2)="authorization number assigned has expired and NCCC has not issued"
S YSCLRSN(3,3)="a new authorization number."
; count 'em
S (DFN,Y)=0 F S DFN=$O(YSPTDISC(DFN)) Q:'DFN S Y=Y+1
D ADD2TXT("Clozapine Discontinued Patient(s) Data was transmitted, "_Y_" record"_$S(Y=1:" was",1:"s were")_" sent.")
D ADD2TXT(" ") ; blank line
S DFN=0 F S DFN=$O(YSPTDISC(DFN)) Q:'DFN D
. K YSCLPT
. Q:'($$GET1^DIQ(55,DFN,54,"I")="D") ; quit if patient wasn't Discontinued
. S YSCLPT("ssnLast4")=$E($$GET1^DIQ(2,DFN,.09),6,9)
. S YSCLPT("ptName&last4")=$$GET1^DIQ(2,DFN,.01)_" ("_YSCLPT("ssnLast4")_")"
. S YSCLPT("disconReason")=YSPTDISC(DFN)
. D ADD2TXT(YSCLPT("ptName&last4"))
. S J=0 F S J=$O(YSCLRSN(YSCLPT("disconReason"),J)) Q:'J D ADD2TXT(YSCLRSN(YSCLPT("disconReason"),J))
;
Q
;
XTMPZRO ;
N J,C
S C=$G(^XTMP("YSCLDIS",0)),J=$$FMADD^XLFDT($$DT^XLFDT,366) ; keep for one year
S $P(C,U)=J,$P(C,U,2)=$$NOW^XLFDT,$P(C,U,3)="DISCONTINUED CLOZAPINE PATIENTS"
S ^XTMP("YSCLDIS",0)=C
Q
;
ADD2TXT(L) ; add line L to the Message text
Q:'$D(L) I L="" S L=" "
N C S C=$G(^TMP($J,"YSCLXDISCMSG",0))+1,^(0)=C,^TMP($J,"YSCLXDISCMSG",C,0)=L
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSCLDIS 8682 printed Sep 23, 2025@19:49:42 Page 2
YSCLDIS ;HINOI/RTW,HEC/HRUBOVCAK - DISCONTINUE CLOZAPINE PATIENT STATUS ; Jun 12, 2023@17:11
+1 ;;5.01;MENTAL HEALTH;**122,154,227**;Dec 30, 1994;Build 17
+2 ;
+3 QUIT
+4 ; Reference to ^DPT supported by IA #10035
+5 ; Reference to ^PS(55 supported by IA #787
+6 ; Reference to $$SITE^VASITE supported by IA #10112
+7 ; Reference to ^DIC supported by DBIA #2051
+8 ; Reference to ^DIE supported by DBIA #2053
+9 ; Reference to ^DIQ supported by DBIA #2056
+10 ; Reference to ^XLFDT supported by DBIA #10103
+11 ; Reference to ^XMD supported by DBIA #10070
+12 ; Reference to ^%DTC supported by DBIA #10000
+13 ;
+14 ;This routine will loop through ^PS(55,DFN,"ASAND" and check the last prescription
+15 ; end date and/or the Inpatient Order stop date. If the patient has not had an active
+16 ; prescription or Inpatent Clozapine Order in the last 56 days, the Active Treatment will STOP
+17 ; YSCLPT("dataFound?") is true if reason found to NOT discontinue the patient
+18 ; routine rewritten for YS*5.01*154 - 27 September 2019
+19 ; OPT and IPT subroutines rewritten to use Pharmacy APIs for YS*5.01*227 - 20 June 2023
+20 ;
START ; called from XMIT^YSCLTST5
+1 DO DT^DICRW
+2 ; YSEND used in DMG^YSCLTST5
+3 ; YSPTDISC - patients discontinued this run
+4 NEW DCONPD,DFN,X,Y,YSCLPT,YSEND,YSPTDISC,YSFMCLOZ,YSLN
+5 ; YS*5.01*227 - Change to use Fileman "parameter" field instead of hard-coded values
+6 SET DCONPD=$$GET1^DIQ(603.03,"1,",13)
+7 SET YSEND=$$FMADD^XLFDT(DT,366)
+8 ; update ^XTMP("YSCLDIS",0)
KILL ^TMP($JOB,"YSCLDATA")
DO XTMPZRO
+9 ; 603.01,1 - CLOZAPINE PATIENT - 0;2 POINTER TO PATIENT FILE (#2)
DO LIST^DIC(603.01,,1,"I",,,,,,,"YSFMCLOZ")
+10 ;
+11 FOR YSLN=1:1
if '$DATA(YSFMCLOZ("DILIST","ID",YSLN))
QUIT
SET DFN=YSFMCLOZ("DILIST","ID",YSLN,1)
if DFN
Begin DoDot:1
+12 KILL YSCLPT,^TMP($JOB,"YSCLDIS")
+13 ; YS*5.01*227 - Use Pharmacy APIs instead of direct Fileman calls per ICR
+14 ; (#53) CLOZAPINE REGISTRATION NUMBER [1F]
+15 DO PSS^PSS781(DFN,,"YSCLDIS")
+16 SET YSCLPT("reg#")=$GET(^TMP($JOB,"YSCLDIS",DFN,53))
if YSCLPT("reg#")=""
QUIT
+17 SET YSCLPT("clozStatus")=$PIECE($GET(^TMP($JOB,"YSCLDIS",DFN,54)),U)
+18 ;Not checking those already discontinued
if YSCLPT("clozStatus")="D"
QUIT
+19 SET YSCLPT("regDate")=$PIECE($GET(^TMP($JOB,"YSCLDIS",DFN,58)),U)
+20 SET YSCLPT("numDays")=$$FMDIFF^XLFDT(DT,YSCLPT("regDate"))
+21 ;temps greater than 4 days since registration
IF YSCLPT("reg#")?1U6N
if YSCLPT("numDays")>4
Begin DoDot:2
+22 SET YSCLPT("disconReason")=3
DO SVPTINFO
DO DSCNPT
DO DMG^YSCLTST5
End DoDot:2
QUIT
+23 ; YS*5.01*227 - Change to use Fileman parameter field instead of hard-coded 28-day value
+24 ;Not checking those registered 27 days or less
if YSCLPT("numDays")<DCONPD
QUIT
+25 SET ^TMP($JOB,"YSCLDATA",DT,DFN)=YSCLPT("reg#")_U_YSCLPT("regDate")
SET YSCLPT("dataFound?")=0
+26 ;Registration is new unless clozapine orders are found
SET YSCLPT("newReg?")=1
+27 ;Not checking further
DO OPT
if YSCLPT("dataFound?")
QUIT
+28 ;
DO INP
if YSCLPT("dataFound?")
QUIT
+29 SET YSCLPT("disconReason")=$SELECT(YSCLPT("newReg?"):1,1:2)
+30 DO SVPTINFO
DO DSCNPT
DO DMG^YSCLTST5
End DoDot:1
+31 ;
+32 DO MSGTRNS
+33 QUIT
OPT ; Outpatient orders
+1 NEW I,YSSTDT,YSUNTDOS,YSCLOPT,YSCLRX,YSCLDRG,YSCLFLDT,YSCLSPDT,X,X1,X2,YSCLFLDA
+2 ; YS*5.01*227 - Rewrite to use Pharmacy APIs because ICR for Fileman reads is deprecated
+3 SET YSSTDT=$$FMADD^XLFDT(DT,-DCONPD)
+4 DO RX^PSO52API(DFN,"YSUNTDOS",,,"2",YSSTDT)
+5 SET I="A"
FOR
SET I=$ORDER(^TMP($JOB,"YSUNTDOS",DFN,I),-1)
if 'I
QUIT
Begin DoDot:1
+6 SET YSCLRX=$GET(^TMP($JOB,"YSUNTDOS",DFN,I,.01))
SET YSCLDRG=$PIECE($GET(^TMP($JOB,"YSUNTDOS",DFN,I,6)),U)
+7 ;Q:'$L($$GET1^DIQ(50,YSCLDRG,17.5)) ;'$D(^PSDRUG("ACLOZ",+YSCLDRG))
+8 DO LAB^PSS50(YSCLDRG,,,,,"YSCLDRG")
+9 if '$LENGTH($GET(^TMP($JOB,"YSCLDRG",YSCLDRG,17.5)))
QUIT
+10 SET YSCLFLDT=$PIECE($GET(^TMP($JOB,"YSUNTDOS",DFN,I,22)),U)
if YSCLFLDT<YSCLPT("regDate")
QUIT
+11 ; Registration isn't new
SET YSCLPT("newReg?")=0
+12 SET YSCLSPDT=$PIECE($GET(^TMP($JOB,"YSUNTDOS",DFN,I,26)),U)
+13 ; Not Expired yet
IF YSCLSPDT'<DT
SET YSCLPT("dataFound?")=1
QUIT
+14 SET X1=DT
SET X2=YSCLFLDT
DO ^%DTC
SET YSCLFLDA=X
+15 ; YS*5.01*227 - Change to use Fileman parameter field instead of hard-coded value
+16 IF YSCLFLDA<DCONPD
SET YSCLPT("dataFound?")=1
End DoDot:1
if YSCLPT("dataFound?")
QUIT
+17 KILL ^TMP($JOB,"YSUNTDOS"),^TMP($JOB,"YSCLDRG")
+18 QUIT
+19 ;
INP ;Inpatient Orders
+1 ; YSDSPDRG - DISPENSE DRUG (sub-file 55.07)
+2 ; YSUNTDOS - UNIT DOSE (sub-file 55.07)
+3 NEW YSUNTDOS,YSDSPDRG,YSCLIPT,YSLINE,YSCLDRG,YSCLORDT,YSCLSPDT,YSCLORDA,X,X1,X2
+4 ; YS*5.01*227 - Rewrite to use Pharmacy APIs because ICR for Fileman reads is deprecated
+5 DO PSS431^PSS55(DFN,,,,"YSUNTDOS")
+6 DO PSS433^PSS55(DFN,"YSUNTDOS2")
+7 SET YSCLIPT="A"
FOR
SET YSCLIPT=$ORDER(^TMP($JOB,"YSUNTDOS",YSCLIPT),-1)
if 'YSCLIPT
QUIT
Begin DoDot:1
+8 SET YSCLDRG=$ORDER(^TMP($JOB,"YSUNTDOS",YSCLIPT,"DDRUG",0))
if '$GET(YSCLDRG)
QUIT
+9 SET YSCLDRG=+$GET(^TMP($JOB,"YSUNTDOS",YSCLIPT,"DDRUG",YSCLDRG,.01))
if '$GET(YSCLDRG)
QUIT
+10 ;Q:$$GET1^DIQ(50,YSCLDRG,17.5)'="PSOCLO1"
+11 DO LAB^PSS50(YSCLDRG,,,,,"YSCLDRG")
+12 if $GET(^TMP($JOB,"YSCLDRG",YSCLDRG,17.5))'="PSOCLO1"
QUIT
+13 ;Order date before Registration
SET YSCLORDT=+$GET(^TMP($JOB,"YSUNTDOS",YSCLIPT,27))
if YSCLORDT<YSCLPT("regDate")
QUIT
+14 ; Registration not new
SET YSCLPT("newReg?")=0
+15 SET YSCLSPDT=+$GET(^TMP($JOB,"YSUNTDOS2",YSCLIPT,34))
+16 ;Not Stopped yet
IF '(YSCLSPDT<DT)
SET YSCLPT("dataFound?")=1
QUIT
+17 SET X1=DT
SET X2=YSCLORDT
DO ^%DTC
SET YSCLORDA=X
+18 ; YS*5.01*227 - Change to use Fileman parameter field instead of hard-coded value
+19 IF YSCLORDA<DCONPD
SET YSCLPT("dataFound?")=1
End DoDot:1
if YSCLPT("dataFound?")
QUIT
+20 KILL ^TMP($JOB,"YSUNTDOS"),^TMP($JOB,"YSUNTDOS2"),^TMP($JOB,"YSCLDRG")
+21 QUIT
+22 ;
SVPTINFO ; save reason for discontinue
+1 NEW J,C,N
+2 ; Change to use Fileman paremeter field instead of hard-coded discontinue period
+3 SET J=YSCLPT("disconReason")
SET C=$SELECT(J=1!(J=2):DCONPD_" days",1:"temp # expired")
SET N=$$NOW^XLFDT
+4 SET ^XTMP("YSCLDIS",N,DFN,0)=J_U_C
SET YSPTDISC(DFN)=YSCLPT("disconReason")
+5 SET ^XTMP("YSCLDIS",N,DFN,"STATUS")=YSCLPT("clozStatus")
+6 QUIT
+7 ;
DSCNPT ; discontinue patient in file #55
+1 ; ^DD(55,54,0) = 'CLOZAPINE STATUS^S'
+2 ; ^DD(55,56,0) = 'DEMOGRAPHICS SENT^S'
+3 NEW DA,DIE,DR
+4 SET DIE="^PS(55,"
SET DA=DFN
SET DR="54///D;56///1"
DO ^DIE
+5 QUIT
+6 ;
MSGTRNS ; transmit message
+1 NEW XMERR,YSBODY,YSFROM,YSITE,YSXMDUZ,YSXMINSTR,YSXMSUBJ,YSXMTO,YSXMZ
+2 KILL ^TMP("XMERR",$JOB),^TMP($JOB,"YSCLXDISCMSG")
+3 ; ^DD(8989.3,501,0) 'PRODUCTION^RS^0:No;1:Yes' Forum for production
+4 IF $$GET1^DIQ(8989.3,1,501,"I")
SET YSXMTO("G.CLOZAPINE ROLL-UP@DOMAIN.EXT")=""
+5 ; always send locally
SET YSXMTO("G.PSOCLOZ")=""
+6 DO YSXMTEXT
+7 SET YSXMINSTR("FROM")="CLOZAPINE MONITOR"
+8 SET Y=$$SITE^VASITE
SET YSXMSUBJ=$PIECE(Y,U,2)_" ("_$PIECE(Y,U,3)_") Discontinued Status"
+9 SET YSBODY=$NAME(^TMP($JOB,"YSCLXDISCMSG"))
+10 DO SENDMSG^XMXAPI(DUZ,YSXMSUBJ,YSBODY,.YSXMTO,.YSXMINSTR,.YSXMZ)
+11 IF $GET(YSXMZ)>0
SET ^XTMP("YSCLDIS",0,"LAST MESSAGE SENT")=YSXMZ_U_$$NOW^XLFDT
+12 ; 603.03,6 - LAST DEMOGRAPHICS TRANSMISSION 0;6 DATE
Begin DoDot:1
+13 NEW DA,DIE,DR
+14 SET DIE="^YSCL(603.03,"
SET DA=1
SET DR="6///"_$$NOW^XLFDT
DO ^DIE
End DoDot:1
+15 ;
+16 KILL ^TMP($JOB,"YSCLXDISCMSG")
+17 ;
+18 QUIT
+19 ;
YSXMTEXT ; build message of discontinued clozapine patients data for NCC
+1 ; YS*5.01*227 - Change to use Fileman parameter field instead of hard-coded discontinue period
+2 NEW J,YSCLRSN
+3 SET YSCLRSN(1,1)="The patient status has changed to 'Discontinued' because the new clozapine"
+4 SET YSCLRSN(1,2)="patient has not filled the prescription/order within "_DCONPD_" days of being"
+5 SET YSCLRSN(1,3)="marked 'Active'."
+6 SET YSCLRSN(2,1)="The patient status has changed to 'Discontinued' because the active clozapine"
+7 SET YSCLRSN(2,2)="patient has not filled the prescription/order within "_DCONPD_" days of"
+8 SET YSCLRSN(2,3)="being prescribed/ordered."
+9 SET YSCLRSN(3,1)="The patient status has changed to 'Discontinued' because the temporary local"
+10 SET YSCLRSN(3,2)="authorization number assigned has expired and NCCC has not issued"
+11 SET YSCLRSN(3,3)="a new authorization number."
+12 ; count 'em
+13 SET (DFN,Y)=0
FOR
SET DFN=$ORDER(YSPTDISC(DFN))
if 'DFN
QUIT
SET Y=Y+1
+14 DO ADD2TXT("Clozapine Discontinued Patient(s) Data was transmitted, "_Y_" record"_$SELECT(Y=1:" was",1:"s were")_" sent.")
+15 ; blank line
DO ADD2TXT(" ")
+16 SET DFN=0
FOR
SET DFN=$ORDER(YSPTDISC(DFN))
if 'DFN
QUIT
Begin DoDot:1
+17 KILL YSCLPT
+18 ; quit if patient wasn't Discontinued
if '($$GET1^DIQ(55,DFN,54,"I")="D")
QUIT
+19 SET YSCLPT("ssnLast4")=$EXTRACT($$GET1^DIQ(2,DFN,.09),6,9)
+20 SET YSCLPT("ptName&last4")=$$GET1^DIQ(2,DFN,.01)_" ("_YSCLPT("ssnLast4")_")"
+21 SET YSCLPT("disconReason")=YSPTDISC(DFN)
+22 DO ADD2TXT(YSCLPT("ptName&last4"))
+23 SET J=0
FOR
SET J=$ORDER(YSCLRSN(YSCLPT("disconReason"),J))
if 'J
QUIT
DO ADD2TXT(YSCLRSN(YSCLPT("disconReason"),J))
End DoDot:1
+24 ;
+25 QUIT
+26 ;
XTMPZRO ;
+1 NEW J,C
+2 ; keep for one year
SET C=$GET(^XTMP("YSCLDIS",0))
SET J=$$FMADD^XLFDT($$DT^XLFDT,366)
+3 SET $PIECE(C,U)=J
SET $PIECE(C,U,2)=$$NOW^XLFDT
SET $PIECE(C,U,3)="DISCONTINUED CLOZAPINE PATIENTS"
+4 SET ^XTMP("YSCLDIS",0)=C
+5 QUIT
+6 ;
ADD2TXT(L) ; add line L to the Message text
+1 if '$DATA(L)
QUIT
IF L=""
SET L=" "
+2 NEW C
SET C=$GET(^TMP($JOB,"YSCLXDISCMSG",0))+1
SET ^(0)=C
SET ^TMP($JOB,"YSCLXDISCMSG",C,0)=L
+3 QUIT
+4 ;
