YSCLSERV ;DALOI/hrubovcak - Clozapine data server ; 8 Nov 2019 15:21:58
;;5.01;MENTAL HEALTH;**18,22,26,47,61,69,74,90,92,122,154,165**;Dec 30, 1994;Build 2
; Reference to ^%ZOSF supported by IA #10096
; Reference to ^DPT supported by IA #10035
; Reference to ^DD("DD" supported by IA #10017
; Reference to ^PS(55 supported by IA #787
; Reference to ^PSDRUG supported by IA #25
; Reference to ^PSRX supported by IA #780
; Reference to ^VA(200 supported by IA #10060
; Reference to $$SITE^VASITE supported by IA #10112
; Reference to $$FMTE^XLFDT() supported by IA #10103
; Reference to ^PSDRUG supported by IA #221
; Reference to ^XMD supported by IA #10070
; Reference to ^DIC supported by DBIA #2051
; Reference to ^DIE supported by DBIA #2053
; Reference to ^DIQ supported by DBIA #2056
; Reference to ^DIK supported by DBIA #10013
; Reference to MIX^DIC1 supported by DBIA #10007
; Reference to FILE^DICN supported by DBIA #10009
; Reference to ^%DTC supported by DBIA #10000
; Reference to ^%DT supported by DBIA #10003
;
START ;
;
D DT^DICRW K ^TMP($J,"YSCLXMSG")
S YSDEBUG=$$GET1^DIQ(603.03,1,3,"I")
S YSCLST=$P($$SITE^VASITE,U,3)
S YSCLSTN=$P($$SITE^VASITE,U,2)
;Determine station number
I $G(PSCLOZ) G UNREG
S X=XQSUB X ^%ZOSF("UPPERCASE") S YSCLSUB=Y
I YSCLSUB["FILE603.01" G LKUP^YSCLSRV3
D ADD2TXT($S(YSDEBUG:"DEBUG ",1:"")_YSCLSUB_" triggered at "_YSCLST_" by "_XMFROM_" on "_XQDATE)
I YSCLSUB["DELETEALL" G DELALL
;The first line of the message tells who requested the action and when
D
.S YSACTION=$S(YSCLSUB["REMOVE"!(YSCLSUB["DELETE"):"data deleted",YSCLSUB["REPORT":"report generated",YSCLSUB["REBUILD":"data verified",YSCLSUB["UPDATE":"data updated",YSCLSUB["DATESET":"date set",1:"CONT")
.I YSACTION="CONT" S YSACTION=$S(YSCLSUB["DEMOG RESET":"Demographics Flag Reset",YSCLSUB["DEBUG":"Debug Mode set",YSCLSUB["AUTH":"Authorization",YSCLSUB["LOCK":"Lock",1:"Site Lock")
.D ADD2TXT($S(YSDEBUG:"DEBUG ",1:"")_YSACTION_" at "_YSCLST)
;The second line tells when the server is activated and no data can be
;gathered from the MailMan message. This line gets replaced if the
;server finds something to do.
I YSCLSUB["REMOVE"!(YSCLSUB["DELETE") G DELETE
;If the subject contains the word REMOVE or DELETE delete those entries from the list.
I YSCLSUB["REPORT" G REPORT
;If the subject contains "REPORT" send a report of the currently registered patients to the Clozapine group on Forum
;I YSCLSUB["REBUILD" G REBUILD
I YSCLSUB["RESEND" G RESEND
I YSCLSUB["UPDATE" G UPDATE
;I YSCLSUB["CHECKSUM" G CSUM^YSCLSRV1
I YSCLSUB["DATESET" G DSET
I YSCLSUB["DEBUG" G DEBUG
I YSCLSUB["PATIENT" G ^YSCLSRV3
I YSCLSUB["LOCKOUT" G LOCK^YSCLSRV3
I YSCLSUB="DEMOG RESET" G DEMOG^YSCLSRV3
I YSCLSUB["AUTHORIZE" G AUTH^YSCLSRV3
I YSCLSUB="OVERRIDE" G OVRRID^YSCLSRV2
I YSCLSUB="CLAPI" G CLAPI^YSCLSRV2
I YSCLSUB="CL1API" G CL1API^YSCLSRV2
I YSCLSUB["DISCON" G DCON^YSCLSRV2
F X XMREC Q:XMER<0 S XMRG=$TR(XMRG,"- ","") D
. ;Verify that + of site number matches local site number
. I XMRG'?2U5N1","9N1","1U S YSCLER=" is in error and was not added at " D OUT Q
. I $P(XMRG,",")'?2U5N S YSCLER=" is not a valid Clozapine number " D OUT Q
. I $P(XMRG,",",2)'?9N S YSCLER=" An SSN must be 9 numbers " D OUT Q
. I $P(XMRG,",",3)'="B",$P(XMRG,",",3)'="W",$P(XMRG,",",3)'="M" S YSCLER=" You must specify Weekly, Biweekly, or Monthly " D OUT Q
. ;Validate the format of the data in the message and report the error.
. ;Do not add data for records where the SSN sent is not in the local database
. S DIC="^DPT(",DIC(0)="X",D="SSN",X=$P(XMRG,",",2)
. N YSFMARRY,YSFREQ D LIST^DIC(2,,.09,,,,X,"SSN",,,"YSFMARRY")
. S DFN=$G(YSFMARRY("DILIST",2,1)) I DFN="" S YSCLER=" SSN does not exist at " D OUT Q
. ;I '$D(^DPT("SSN",X)) S YSCLER=" SSN does not exist at " D OUT Q
. K YSFMARRY D LIST^DIC(603.01,,1,,,,$P(XMRG,","),,,,"YSFMARRY")
. I $D(YSFMARRY("DILIST","ID",1,1)) D D OUT Q
. . S YSCLER=" Clozapine # is in use by "_YSFMARRY("DILIST","ID",1,1)_" at "
. ;I $D(^YSCL(603.01,"B",$P(XMRG,","))) S YSCLX=$O(^YSCL(603.01,"B",$P(XMRG,","),"")) S:YSCLX]"" YSCLX=$P(^YSCL(603.01,YSCLX,0),U,2),YSCLER=" Clozapine # is in use by "_$P($G(^DPT(YSCLX,0)),U)_" at " D OUT Q
. D MIX^DIC1 S YSCLPT=+Y I Y=-1 S YSCLER=" could not be added at " D OUT Q
. ;Add the data and report any errors to the Roll-Up group at Forum.
. K DD S DIC="^YSCL(603.01,",YSFREQ=$P(XMRG,",",3) S:YSFREQ="" YSFREQ="W" ; default to weekly
. S X=$P(XMRG,","),DIC("DR")="1////"_YSCLPT_";2////"_$S("BMW"[YSFREQ:YSFREQ,1:"W"),DIC(0)="Z" K DO D FILE^DICN
. K YSFMARRY D LIST^DIC(603.01,,".01E;1E;2E",,,,$P(XMRG,","),,,,"YSFMARRY")
. I $D(YSFMARRY("DILIST","ID",1,1)) D
. S YSCLER=" assigned to "_YSFMARRY("DILIST","ID",1,1)_" at " D OUT
;
EXIT ;If all went well, report that too.
S YSDEBUG=$$GET1^DIQ(603.03,1,3,"I")
S XMDUN="NCCC LOGGER",XMDUZ=".5",XMSUB=$S(YSDEBUG:"DEBUG ",YSCLSUB["DEBUG":"DEBUG ",1:"")_YSCLST_" NCCC ENROLLER ("_$$NOW^XLFDT_")"
;
;/MZR -Begin modifications for YS*5.01*122
K XMY N YSPROD,YSXMZ
S YSPROD=$$GET1^DIQ(8989.3,1,501,"I")
D:YSPROD
. I 'YSDEBUG S XMY("G.CLOZAPINE ROLL-UP@DOMAIN.EXT")="" Q
. S XMY("G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT")=""
S:'YSPROD XMY("G.CLOZAPINE ROLL-UP")="",XMY("G.PSOCLOZ")=""
;/MZR - End modifications for YS*5.01*122
;
D ; add mail group info to message text
. D ADD2TXT(" ")
. N G S G="G." F S G=$O(XMY(G)) Q:G="" D ADD2TXT(" Sent to: "_G)
. D ADD2TXT(" "),ADD2TXT($J("*** END OF REPORT ***",45))
; Mail the errors and successes back to the Roll-Up group at Forum.
D SENDMSG^XMXAPI(DUZ,XMSUB,$NA(^TMP($J,"YSCLXMSG")),.XMY,"",.YSXMZ)
;
K ^TMP($J,"YSCLXMSG")
K %,%DT,%H,D,DA,DD,DIC,DIE,DIK,RET,X,XMDUN,XMDUZ,XMER,XMFROM
K XMREC,XMRG,XMSUB,XMTEXT,XMY,XMZ,XQDATE,XQSUB,Y,YSA,YSACTION,YSCLTYPE
K YSCL28,YSCLA,YSCLAA,YSCLB,YSCLC,YSCLDA,YSCLDA1,YSCLDATA,YSCLDEA1
K YSCLDFN,YSCLDM,YSCLDOC,YSCLDOM,YSCLDR,YSCLDRA,YSCLDRB,YSCLDTA,YSCLERR
K YSCLDUZ,YSCLED,YSCLER,YSCLFDA,YSCLFRQ,YSCLLNT,YSCLNM,YSCLOVR,YSCLSITE
K YSCLPT,YSCLRPT,YSCLSD1,YSCLSDT,YSCLSSN,YSCLST,YSCLSTN,YSCLSUB,YSCLTC
K YSCLRX,YSCLSAND,YSCLWB,YSCLX,YSCLYN,YSDEBUG,YSI,YSOFF,YSPR,ZTQUEUED,ZTSK
Q
;/RBN Begin mods - YS*5.01*122
UNREG I $G(PSCLOZ) D Q
. ;Verify that + of site number matches local site number
. I XMRG'?1U4.6N1",".U1",".U1","4N S YSCLER=" is in error and was not added at " D OUT Q
. I $P(XMRG,",")'?1U4.6N S YSCLER=" is not a valid Clozapine number " D OUT Q
. I $P(XMRG,",",4)'?4N S YSCLER=" An SSN must be 4 numbers " D OUT Q
. ;Validate the format of the data in the message and report the error.
. ;Do not add data for records where the SSN sent is not in the local database
. S DIC="^DPT(",DIC(0)="X",D="SSN",X=SSN
. N YSFMARRY D LIST^DIC(2,,.09,,,,X,"SSN",,,"YSFMARRY")
. S DFN=$G(YSFMARRY("DILIST",2,1)) I DFN="" S YSCLER=" SSN does not exist at " D OUT Q
. K YSFMARRY D LIST^DIC(603.01,,1,,,,$P(XMRG,","),,,,"YSFMARRY")
. I $D(YSFMARRY("DILIST","ID",1,1)) D D OUT Q
. . S YSCLER=" Clozapine # is in use by "_YSFMARRY("DILIST","ID",1,1)_" at "
. D MIX^DIC1 S YSCLPT=+Y I Y=-1 S YSCLER=" could not be added at " D OUT Q
. ;Add the data and report any errors to the Roll-Up group at Forum.
. K DD S DIC="^YSCL(603.01,",X=$P(XMRG,","),DIC("DR")="1////"_YSCLPT_";2////"_"W" K DO D FILE^DICN
. K YSFMARRY D LIST^DIC(603.01,,1,,,,$P(XMRG,","),,,,"YSFMARRY")
. I $D(YSFMARRY("DILIST","ID",1,1)) S YSCLER=" assigned to "_YSFMARRY("DILIST","ID",1,1)_" at " D OUT
;/RBN End mods - YS*5.01*122
Q
DELETE ;Allow the NCCC users to delete clozapine registration at the individual sites
I XQSUB["DELETEALL" G DELALL
F X XMREC Q:XMER<0 S XMRG=$TR(XMRG,"- ","") D
. I XMRG="**++**DELETEALL**++**" D DELALL Q
. N YSFMARRY D LIST^DIC(603.01,,1,,,,$P(XMRG,","),,,,"YSFMARRY")
. I '$D(YSFMARRY("DILIST","ID",1,1)) S YSCLER=" "_$P(XMRG,",")_" is not registered at " D OUT Q
. ;I '$D(^YSCL(603.01,"B",$P(XMRG,","))) S YSCLER=" "_$P(XMRG,",")_" is not registered at " D OUT Q
. N YSFMARRY D LIST^DIC(2,,.09,,,,$P(XMRG,",",2),"SSN",,,"YSFMARRY")
. S YSCLDFN=$G(YSFMARRY("DILIST",2,1)) I YSCLDFN="" S YSCLER=" "_$P(XMRG,",",2)_" is not a valid SSN at " D OUT Q
. ;S YSCLDFN=$O(^DPT("SSN",$P(XMRG,",",2),"")) I YSCLDFN="" S YSCLER=" "_$P(XMRG,",")_" is not a valid SSN at " D OUT Q
. K YSFMARRY D LIST^DIC(603.01,,1,"I",,,YSCLDFN,"C",,,"YSFMARRY")
. I '$D(YSFMARRY("DILIST","ID",1,1)) S YSCLER=" "_$P(XMRG,",",2)_" is not registered at " D OUT Q
. ;I '$D(^YSCL(603.01,"C",YSCLDFN)) S YSCLER=" "_$P(XMRG,",",2)_" is not registered at " D OUT Q
. S YSCLA=YSFMARRY("DILIST",2,1) ;I YSCLA="" S YSCLER=" "_$P(XMRG,",")_" is not a valid entry at " D OUT Q
. ;K ^YSCL(603.01,YSCLA),^YSCL(603.01,"B",$P(XMRG,","),YSCLA),^YSCL(603.01,"C",YSCLDFN,YSCLA)
. S DIK="^YSCL(603.01,",DA=YSCLA D ^DIK
. S YSCLER=" removed at " D OUT
. ;I $D(^YSCL(603.01,"C",+Y)) K ^YSCL(603.01,YSCLA),^YSCL(603.01,"B",$P(XMRG,","),YSCLA),^YSCL(603.01,"C",YSCLDFN,YSCLA) S YSCLER=" removed at " D OUT Q ;RLM 9-29-99 ADDED QUIT
G EXIT
DELALL ;Delete all patients in file 603.01
;
D ADD2TXT("The deletion of ALL patients in File #603.01 has been disabled.")
D ADD2TXT("No action taken.")
G EXIT
;
N YSFMARRY,DFN,YSCLA,YSCLREGN
D LIST^DIC(603.01,,"1;2","I",,,,"C",,,"YSFMARRY")
F I=1:1 Q:'$D(YSFMARRY("DILIST",2,I)) S YSCLA=YSFMARRY("DILIST",2,I) D:YSCLA
. S DFN=YSFMARRY("DILIST",1,I),YSCLREGN=YSFMARRY("DILIST","ID",I,.01)
. S YSCLER=YSCLREGN_", "_$$GET1^DIQ(2,DFN,.09)_", ("_YSFMARRY("DILIST","ID",I,2)_") deleted at " D OUT
. S DIK="^YSCL(603.01,",DA=YSCLA D ^DIK ;K ^YSCL(603.01,YSCLA)
Q
REPORT ;send report of current registrations to the Clozapine group on Forum
D REPORT^YSCLSRV2 G EXIT
OUT ;
D ADD2TXT(XMRG_YSCLER_YSCLST) Q
;Build the text for the return message here.
REBUILD ;
D REBUILD^YSCLSRV2 G EXIT
UPDATE ;Update record with Monthly, Weekly or Bi-weekly status
N YSARRAY D LIST^DIC(603.01,,,"I",,,,,,,"YSARRAY")
F I=1:1 Q:'$D(YSARRAY("DILIST",2,I)) D
.S YSARRAY(YSARRAY("DILIST",2,I))=YSARRAY("DILIST",1,I)
.S YSARRAY("B",YSARRAY("DILIST",1,I))=YSARRAY("DILIST",2,I)
K YSARRAY("DILIST")
F X XMREC Q:XMER<0 S XMRG=$TR(XMRG,"- ","") D
. I XMRG'?2U5N1","9N1","1U S YSCLER=" is in error and was not added at " D OUT Q
. I $P(XMRG,",")'?2U5N S YSCLER=" is not a valid Clozapine number format " D OUT Q
. I $P(XMRG,",",2)'?9N S YSCLER=" An SSN must be 9 numbers " D OUT Q
. I $P(XMRG,",",3)'="B",$P(XMRG,",",3)'="W",$P(XMRG,",",3)'="M" S YSCLER=" You must specify Monthly, Weekly or Biweekly " D OUT Q ;RLM 06/15/05
. S YSCLNM=$P(XMRG,","),YSCLSSN=$P(XMRG,",",2),YSCLWB=$P(XMRG,",",3)
. I '$D(YSARRAY("B",YSCLNM)) S YSCLER=" does not exist at " D OUT Q
. N YSFMARRY D LIST^DIC(2,,.09,,,,YSCLSSN,"SSN",,,"YSFMARRY")
. S YSCLDA=$G(YSFMARRY("DILIST",2,1)) I 'YSCLDA S YSCLER=" SSN does not exist at " D OUT Q
. K YSFMARRY D LIST^DIC(603.01,,1,"I",,,YSCLDA,"C",,,"YSFMARRY")
. S YSCLDA1=$G(YSFMARRY("DILIST",2,1)) I 'YSCLDA1 S YSCLER=" SSN not in Clozapine file " D OUT Q
. D
. . S DIE=603.01,DA=YSCLDA1,DR="2///"_YSCLWB D ^DIE
. . S YSCLER=" "_YSCLNM_" ("_$$GET1^DIQ(2,YSCLDA,.09)_") updated to "_$S(YSCLWB="M":"Monthly",YSCLWB="W":"Weekly",YSCLWB="B":"Bi-weekly",1:"Unknown")_" at " D OUT ;06/15/05
G EXIT
RESEND ;Trigger retransmission of Clozapine data
X XMREC
I $L(XMRG,U)<1!($L(XMRG,U)>2) S YSCLER=" is an invalid date(s), RESEND not triggered at " D OUT G EXIT
S YSCLSTDT=$P(XMRG,U,1)
K %DT S X=YSCLSTDT,%DT="P" D ^%DT I Y=-1 S YSCLER=" is an invalid start date, RESEND not triggered at " D OUT G EXIT
S X1=Y,X2=-1 D C^%DTC S YSCLSTDT=X
I $L(XMRG,U)>1 S YSCLEDDT=$P(XMRG,U,2) K %DT S X=YSCLEDDT,%DT="P" D ^%DT I Y=-1 S YSCLER=" is an invalid end date, RESEND not triggered at " D OUT G EXIT
S X1=Y,X2=1 D C^%DTC S YSCLEDDT=X
I $L(XMRG,U)=1 S X1=YSCLSTDT,X2=2 D C^%DTC S YSCLEDDT=X
S X1=YSCLEDDT,X2=YSCLSTDT D ^%DTC I X<0 S YSCLER=" ending date cannot be less than start date, RESEND not triggered at " D OUT G EXIT
N YSCLREX
S YSCLREX=1
S (YSCLTRDT,YSCLSDT)=YSCLSTDT
D REXMIT^YSCLTST5
S Y=YSCLSDT X ^DD("DD") S YSCLER=" - Resend triggered (local task #"_$G(ZTSK)_") by "_XMFROM_" for "_Y_" at " D OUT
G EXIT
DSET ;Set the day of the week for the roll-up to run.
X XMREC Q:XMER<0 S X=$TR(XMRG,"- ","")
S YSOFF=$S(X="SUNDAY":0,X="MONDAY":1,X="TUESDAY":2,X="WEDNESDAY":3,X="THURSDAY":4,X="FRIDAY":5,X="SATURDAY":6,1:7)
I YSOFF>6 D ADD2TXT(X_" isn't a valid day of the week.") G EXIT
S DIE="^YSCL(603.03,",DA=1,DR="2////"_X D ^DIE ;S $P(^YSCL(603.03,1,0),U,2)=X
D ADD2TXT("Run day set to "_X)
G EXIT
Q
DEBUG ;Turn debug mode on and off.
I YSCLSUB["DEBUG ON" D
. D ADD2TXT("Debug Mode is "_$S(YSDEBUG:"already",1:"now")_" ON at "_YSCLSTN)
. S DIE="^YSCL(603.03,",DA=1,DR="3////1" D ^DIE ;S $P(^YSCL(603.03,1,0),U,3)=1
I YSCLSUB["DEBUG OFF" D
. D ADD2TXT("Debug Mode is "_$S('YSDEBUG:"already",1:"now")_" OFF at "_YSCLSTN)
. S DIE="^YSCL(603.03,",DA=1,DR="3////0" D ^DIE ;S $P(^YSCL(603.03,1,0),U,3)=0
G EXIT
;
ADD2TXT(L) ; add line L to the Message text
Q:'$D(L) I L="" S L=" "
N C S C=$G(^TMP($J,"YSCLXMSG",0))+1,^(0)=C,^TMP($J,"YSCLXMSG",C,0)=L
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSCLSERV 13376 printed Sep 23, 2025@19:49:54 Page 2
YSCLSERV ;DALOI/hrubovcak - Clozapine data server ; 8 Nov 2019 15:21:58
+1 ;;5.01;MENTAL HEALTH;**18,22,26,47,61,69,74,90,92,122,154,165**;Dec 30, 1994;Build 2
+2 ; Reference to ^%ZOSF supported by IA #10096
+3 ; Reference to ^DPT supported by IA #10035
+4 ; Reference to ^DD("DD" supported by IA #10017
+5 ; Reference to ^PS(55 supported by IA #787
+6 ; Reference to ^PSDRUG supported by IA #25
+7 ; Reference to ^PSRX supported by IA #780
+8 ; Reference to ^VA(200 supported by IA #10060
+9 ; Reference to $$SITE^VASITE supported by IA #10112
+10 ; Reference to $$FMTE^XLFDT() supported by IA #10103
+11 ; Reference to ^PSDRUG supported by IA #221
+12 ; Reference to ^XMD supported by IA #10070
+13 ; Reference to ^DIC supported by DBIA #2051
+14 ; Reference to ^DIE supported by DBIA #2053
+15 ; Reference to ^DIQ supported by DBIA #2056
+16 ; Reference to ^DIK supported by DBIA #10013
+17 ; Reference to MIX^DIC1 supported by DBIA #10007
+18 ; Reference to FILE^DICN supported by DBIA #10009
+19 ; Reference to ^%DTC supported by DBIA #10000
+20 ; Reference to ^%DT supported by DBIA #10003
+21 ;
START ;
+1 ;
+2 DO DT^DICRW
KILL ^TMP($JOB,"YSCLXMSG")
+3 SET YSDEBUG=$$GET1^DIQ(603.03,1,3,"I")
+4 SET YSCLST=$PIECE($$SITE^VASITE,U,3)
+5 SET YSCLSTN=$PIECE($$SITE^VASITE,U,2)
+6 ;Determine station number
+7 IF $GET(PSCLOZ)
GOTO UNREG
+8 SET X=XQSUB
XECUTE ^%ZOSF("UPPERCASE")
SET YSCLSUB=Y
+9 IF YSCLSUB["FILE603.01"
GOTO LKUP^YSCLSRV3
+10 DO ADD2TXT($SELECT(YSDEBUG:"DEBUG ",1:"")_YSCLSUB_" triggered at "_YSCLST_" by "_XMFROM_" on "_XQDATE)
+11 IF YSCLSUB["DELETEALL"
GOTO DELALL
+12 ;The first line of the message tells who requested the action and when
+13 Begin DoDot:1
+14 SET YSACTION=$SELECT(YSCLSUB["REMOVE"!(YSCLSUB["DELETE"):"data deleted",YSCLSUB["REPORT":"report generated",YSCLSUB["REBUILD":"data verified",YSCLSUB["UPDATE":"data updated",YSCLSUB["DATESET":"date set",1:"CONT")
+15 IF YSACTION="CONT"
SET YSACTION=$SELECT(YSCLSUB["DEMOG RESET":"Demographics Flag Reset",YSCLSUB["DEBUG":"Debug Mode set",YSCLSUB["AUTH":"Authorization",YSCLSUB["LOCK":"Lock",1:"Site Lock")
+16 DO ADD2TXT($SELECT(YSDEBUG:"DEBUG ",1:"")_YSACTION_" at "_YSCLST)
End DoDot:1
+17 ;The second line tells when the server is activated and no data can be
+18 ;gathered from the MailMan message. This line gets replaced if the
+19 ;server finds something to do.
+20 IF YSCLSUB["REMOVE"!(YSCLSUB["DELETE")
GOTO DELETE
+21 ;If the subject contains the word REMOVE or DELETE delete those entries from the list.
+22 IF YSCLSUB["REPORT"
GOTO REPORT
+23 ;If the subject contains "REPORT" send a report of the currently registered patients to the Clozapine group on Forum
+24 ;I YSCLSUB["REBUILD" G REBUILD
+25 IF YSCLSUB["RESEND"
GOTO RESEND
+26 IF YSCLSUB["UPDATE"
GOTO UPDATE
+27 ;I YSCLSUB["CHECKSUM" G CSUM^YSCLSRV1
+28 IF YSCLSUB["DATESET"
GOTO DSET
+29 IF YSCLSUB["DEBUG"
GOTO DEBUG
+30 IF YSCLSUB["PATIENT"
GOTO ^YSCLSRV3
+31 IF YSCLSUB["LOCKOUT"
GOTO LOCK^YSCLSRV3
+32 IF YSCLSUB="DEMOG RESET"
GOTO DEMOG^YSCLSRV3
+33 IF YSCLSUB["AUTHORIZE"
GOTO AUTH^YSCLSRV3
+34 IF YSCLSUB="OVERRIDE"
GOTO OVRRID^YSCLSRV2
+35 IF YSCLSUB="CLAPI"
GOTO CLAPI^YSCLSRV2
+36 IF YSCLSUB="CL1API"
GOTO CL1API^YSCLSRV2
+37 IF YSCLSUB["DISCON"
GOTO DCON^YSCLSRV2
+38 FOR
XECUTE XMREC
if XMER<0
QUIT
SET XMRG=$TRANSLATE(XMRG,"- ","")
Begin DoDot:1
+39 ;Verify that + of site number matches local site number
+40 IF XMRG'?2U5N1","9N1","1U
SET YSCLER=" is in error and was not added at "
DO OUT
QUIT
+41 IF $PIECE(XMRG,",")'?2U5N
SET YSCLER=" is not a valid Clozapine number "
DO OUT
QUIT
+42 IF $PIECE(XMRG,",",2)'?9N
SET YSCLER=" An SSN must be 9 numbers "
DO OUT
QUIT
+43 IF $PIECE(XMRG,",",3)'="B"
IF $PIECE(XMRG,",",3)'="W"
IF $PIECE(XMRG,",",3)'="M"
SET YSCLER=" You must specify Weekly, Biweekly, or Monthly "
DO OUT
QUIT
+44 ;Validate the format of the data in the message and report the error.
+45 ;Do not add data for records where the SSN sent is not in the local database
+46 SET DIC="^DPT("
SET DIC(0)="X"
SET D="SSN"
SET X=$PIECE(XMRG,",",2)
+47 NEW YSFMARRY,YSFREQ
DO LIST^DIC(2,,.09,,,,X,"SSN",,,"YSFMARRY")
+48 SET DFN=$GET(YSFMARRY("DILIST",2,1))
IF DFN=""
SET YSCLER=" SSN does not exist at "
DO OUT
QUIT
+49 ;I '$D(^DPT("SSN",X)) S YSCLER=" SSN does not exist at " D OUT Q
+50 KILL YSFMARRY
DO LIST^DIC(603.01,,1,,,,$PIECE(XMRG,","),,,,"YSFMARRY")
+51 IF $DATA(YSFMARRY("DILIST","ID",1,1))
Begin DoDot:2
+52 SET YSCLER=" Clozapine # is in use by "_YSFMARRY("DILIST","ID",1,1)_" at "
End DoDot:2
DO OUT
QUIT
+53 ;I $D(^YSCL(603.01,"B",$P(XMRG,","))) S YSCLX=$O(^YSCL(603.01,"B",$P(XMRG,","),"")) S:YSCLX]"" YSCLX=$P(^YSCL(603.01,YSCLX,0),U,2),YSCLER=" Clozapine # is in use by "_$P($G(^DPT(YSCLX,0)),U)_" at " D OUT Q
+54 DO MIX^DIC1
SET YSCLPT=+Y
IF Y=-1
SET YSCLER=" could not be added at "
DO OUT
QUIT
+55 ;Add the data and report any errors to the Roll-Up group at Forum.
+56 ; default to weekly
KILL DD
SET DIC="^YSCL(603.01,"
SET YSFREQ=$PIECE(XMRG,",",3)
if YSFREQ=""
SET YSFREQ="W"
+57 SET X=$PIECE(XMRG,",")
SET DIC("DR")="1////"_YSCLPT_";2////"_$SELECT("BMW"[YSFREQ:YSFREQ,1:"W")
SET DIC(0)="Z"
KILL DO
DO FILE^DICN
+58 KILL YSFMARRY
DO LIST^DIC(603.01,,".01E;1E;2E",,,,$PIECE(XMRG,","),,,,"YSFMARRY")
+59 IF $DATA(YSFMARRY("DILIST","ID",1,1))
Begin DoDot:2
End DoDot:2
+60 SET YSCLER=" assigned to "_YSFMARRY("DILIST","ID",1,1)_" at "
DO OUT
End DoDot:1
+61 ;
EXIT ;If all went well, report that too.
+1 SET YSDEBUG=$$GET1^DIQ(603.03,1,3,"I")
+2 SET XMDUN="NCCC LOGGER"
SET XMDUZ=".5"
SET XMSUB=$SELECT(YSDEBUG:"DEBUG ",YSCLSUB["DEBUG":"DEBUG ",1:"")_YSCLST_" NCCC ENROLLER ("_$$NOW^XLFDT_")"
+3 ;
+4 ;/MZR -Begin modifications for YS*5.01*122
+5 KILL XMY
NEW YSPROD,YSXMZ
+6 SET YSPROD=$$GET1^DIQ(8989.3,1,501,"I")
+7 if YSPROD
Begin DoDot:1
+8 IF 'YSDEBUG
SET XMY("G.CLOZAPINE ROLL-UP@DOMAIN.EXT")=""
QUIT
+9 SET XMY("G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT")=""
End DoDot:1
+10 if 'YSPROD
SET XMY("G.CLOZAPINE ROLL-UP")=""
SET XMY("G.PSOCLOZ")=""
+11 ;/MZR - End modifications for YS*5.01*122
+12 ;
+13 ; add mail group info to message text
Begin DoDot:1
+14 DO ADD2TXT(" ")
+15 NEW G
SET G="G."
FOR
SET G=$ORDER(XMY(G))
if G=""
QUIT
DO ADD2TXT(" Sent to: "_G)
+16 DO ADD2TXT(" ")
DO ADD2TXT($JUSTIFY("*** END OF REPORT ***",45))
End DoDot:1
+17 ; Mail the errors and successes back to the Roll-Up group at Forum.
+18 DO SENDMSG^XMXAPI(DUZ,XMSUB,$NAME(^TMP($JOB,"YSCLXMSG")),.XMY,"",.YSXMZ)
+19 ;
+20 KILL ^TMP($JOB,"YSCLXMSG")
+21 KILL %,%DT,%H,D,DA,DD,DIC,DIE,DIK,RET,X,XMDUN,XMDUZ,XMER,XMFROM
+22 KILL XMREC,XMRG,XMSUB,XMTEXT,XMY,XMZ,XQDATE,XQSUB,Y,YSA,YSACTION,YSCLTYPE
+23 KILL YSCL28,YSCLA,YSCLAA,YSCLB,YSCLC,YSCLDA,YSCLDA1,YSCLDATA,YSCLDEA1
+24 KILL YSCLDFN,YSCLDM,YSCLDOC,YSCLDOM,YSCLDR,YSCLDRA,YSCLDRB,YSCLDTA,YSCLERR
+25 KILL YSCLDUZ,YSCLED,YSCLER,YSCLFDA,YSCLFRQ,YSCLLNT,YSCLNM,YSCLOVR,YSCLSITE
+26 KILL YSCLPT,YSCLRPT,YSCLSD1,YSCLSDT,YSCLSSN,YSCLST,YSCLSTN,YSCLSUB,YSCLTC
+27 KILL YSCLRX,YSCLSAND,YSCLWB,YSCLX,YSCLYN,YSDEBUG,YSI,YSOFF,YSPR,ZTQUEUED,ZTSK
+28 QUIT
+29 ;/RBN Begin mods - YS*5.01*122
UNREG IF $GET(PSCLOZ)
Begin DoDot:1
+1 ;Verify that + of site number matches local site number
+2 IF XMRG'?1U4.6N1",".U1",".U1","4N
SET YSCLER=" is in error and was not added at "
DO OUT
QUIT
+3 IF $PIECE(XMRG,",")'?1U4.6N
SET YSCLER=" is not a valid Clozapine number "
DO OUT
QUIT
+4 IF $PIECE(XMRG,",",4)'?4N
SET YSCLER=" An SSN must be 4 numbers "
DO OUT
QUIT
+5 ;Validate the format of the data in the message and report the error.
+6 ;Do not add data for records where the SSN sent is not in the local database
+7 SET DIC="^DPT("
SET DIC(0)="X"
SET D="SSN"
SET X=SSN
+8 NEW YSFMARRY
DO LIST^DIC(2,,.09,,,,X,"SSN",,,"YSFMARRY")
+9 SET DFN=$GET(YSFMARRY("DILIST",2,1))
IF DFN=""
SET YSCLER=" SSN does not exist at "
DO OUT
QUIT
+10 KILL YSFMARRY
DO LIST^DIC(603.01,,1,,,,$PIECE(XMRG,","),,,,"YSFMARRY")
+11 IF $DATA(YSFMARRY("DILIST","ID",1,1))
Begin DoDot:2
+12 SET YSCLER=" Clozapine # is in use by "_YSFMARRY("DILIST","ID",1,1)_" at "
End DoDot:2
DO OUT
QUIT
+13 DO MIX^DIC1
SET YSCLPT=+Y
IF Y=-1
SET YSCLER=" could not be added at "
DO OUT
QUIT
+14 ;Add the data and report any errors to the Roll-Up group at Forum.
+15 KILL DD
SET DIC="^YSCL(603.01,"
SET X=$PIECE(XMRG,",")
SET DIC("DR")="1////"_YSCLPT_";2////"_"W"
KILL DO
DO FILE^DICN
+16 KILL YSFMARRY
DO LIST^DIC(603.01,,1,,,,$PIECE(XMRG,","),,,,"YSFMARRY")
+17 IF $DATA(YSFMARRY("DILIST","ID",1,1))
SET YSCLER=" assigned to "_YSFMARRY("DILIST","ID",1,1)_" at "
DO OUT
End DoDot:1
QUIT
+18 ;/RBN End mods - YS*5.01*122
+19 QUIT
DELETE ;Allow the NCCC users to delete clozapine registration at the individual sites
+1 IF XQSUB["DELETEALL"
GOTO DELALL
+2 FOR
XECUTE XMREC
if XMER<0
QUIT
SET XMRG=$TRANSLATE(XMRG,"- ","")
Begin DoDot:1
+3 IF XMRG="**++**DELETEALL**++**"
DO DELALL
QUIT
+4 NEW YSFMARRY
DO LIST^DIC(603.01,,1,,,,$PIECE(XMRG,","),,,,"YSFMARRY")
+5 IF '$DATA(YSFMARRY("DILIST","ID",1,1))
SET YSCLER=" "_$PIECE(XMRG,",")_" is not registered at "
DO OUT
QUIT
+6 ;I '$D(^YSCL(603.01,"B",$P(XMRG,","))) S YSCLER=" "_$P(XMRG,",")_" is not registered at " D OUT Q
+7 NEW YSFMARRY
DO LIST^DIC(2,,.09,,,,$PIECE(XMRG,",",2),"SSN",,,"YSFMARRY")
+8 SET YSCLDFN=$GET(YSFMARRY("DILIST",2,1))
IF YSCLDFN=""
SET YSCLER=" "_$PIECE(XMRG,",",2)_" is not a valid SSN at "
DO OUT
QUIT
+9 ;S YSCLDFN=$O(^DPT("SSN",$P(XMRG,",",2),"")) I YSCLDFN="" S YSCLER=" "_$P(XMRG,",")_" is not a valid SSN at " D OUT Q
+10 KILL YSFMARRY
DO LIST^DIC(603.01,,1,"I",,,YSCLDFN,"C",,,"YSFMARRY")
+11 IF '$DATA(YSFMARRY("DILIST","ID",1,1))
SET YSCLER=" "_$PIECE(XMRG,",",2)_" is not registered at "
DO OUT
QUIT
+12 ;I '$D(^YSCL(603.01,"C",YSCLDFN)) S YSCLER=" "_$P(XMRG,",",2)_" is not registered at " D OUT Q
+13 ;I YSCLA="" S YSCLER=" "_$P(XMRG,",")_" is not a valid entry at " D OUT Q
SET YSCLA=YSFMARRY("DILIST",2,1)
+14 ;K ^YSCL(603.01,YSCLA),^YSCL(603.01,"B",$P(XMRG,","),YSCLA),^YSCL(603.01,"C",YSCLDFN,YSCLA)
+15 SET DIK="^YSCL(603.01,"
SET DA=YSCLA
DO ^DIK
+16 SET YSCLER=" removed at "
DO OUT
+17 ;I $D(^YSCL(603.01,"C",+Y)) K ^YSCL(603.01,YSCLA),^YSCL(603.01,"B",$P(XMRG,","),YSCLA),^YSCL(603.01,"C",YSCLDFN,YSCLA) S YSCLER=" removed at " D OUT Q ;RLM 9-29-99 ADDED QUIT
End DoDot:1
+18 GOTO EXIT
DELALL ;Delete all patients in file 603.01
+1 ;
+2 DO ADD2TXT("The deletion of ALL patients in File #603.01 has been disabled.")
+3 DO ADD2TXT("No action taken.")
+4 GOTO EXIT
+5 ;
+6 NEW YSFMARRY,DFN,YSCLA,YSCLREGN
+7 DO LIST^DIC(603.01,,"1;2","I",,,,"C",,,"YSFMARRY")
+8 FOR I=1:1
if '$DATA(YSFMARRY("DILIST",2,I))
QUIT
SET YSCLA=YSFMARRY("DILIST",2,I)
if YSCLA
Begin DoDot:1
+9 SET DFN=YSFMARRY("DILIST",1,I)
SET YSCLREGN=YSFMARRY("DILIST","ID",I,.01)
+10 SET YSCLER=YSCLREGN_", "_$$GET1^DIQ(2,DFN,.09)_", ("_YSFMARRY("DILIST","ID",I,2)_") deleted at "
DO OUT
+11 ;K ^YSCL(603.01,YSCLA)
SET DIK="^YSCL(603.01,"
SET DA=YSCLA
DO ^DIK
End DoDot:1
+12 QUIT
REPORT ;send report of current registrations to the Clozapine group on Forum
+1 DO REPORT^YSCLSRV2
GOTO EXIT
OUT ;
+1 DO ADD2TXT(XMRG_YSCLER_YSCLST)
QUIT
+2 ;Build the text for the return message here.
REBUILD ;
+1 DO REBUILD^YSCLSRV2
GOTO EXIT
UPDATE ;Update record with Monthly, Weekly or Bi-weekly status
+1 NEW YSARRAY
DO LIST^DIC(603.01,,,"I",,,,,,,"YSARRAY")
+2 FOR I=1:1
if '$DATA(YSARRAY("DILIST",2,I))
QUIT
Begin DoDot:1
+3 SET YSARRAY(YSARRAY("DILIST",2,I))=YSARRAY("DILIST",1,I)
+4 SET YSARRAY("B",YSARRAY("DILIST",1,I))=YSARRAY("DILIST",2,I)
End DoDot:1
+5 KILL YSARRAY("DILIST")
+6 FOR
XECUTE XMREC
if XMER<0
QUIT
SET XMRG=$TRANSLATE(XMRG,"- ","")
Begin DoDot:1
+7 IF XMRG'?2U5N1","9N1","1U
SET YSCLER=" is in error and was not added at "
DO OUT
QUIT
+8 IF $PIECE(XMRG,",")'?2U5N
SET YSCLER=" is not a valid Clozapine number format "
DO OUT
QUIT
+9 IF $PIECE(XMRG,",",2)'?9N
SET YSCLER=" An SSN must be 9 numbers "
DO OUT
QUIT
+10 ;RLM 06/15/05
IF $PIECE(XMRG,",",3)'="B"
IF $PIECE(XMRG,",",3)'="W"
IF $PIECE(XMRG,",",3)'="M"
SET YSCLER=" You must specify Monthly, Weekly or Biweekly "
DO OUT
QUIT
+11 SET YSCLNM=$PIECE(XMRG,",")
SET YSCLSSN=$PIECE(XMRG,",",2)
SET YSCLWB=$PIECE(XMRG,",",3)
+12 IF '$DATA(YSARRAY("B",YSCLNM))
SET YSCLER=" does not exist at "
DO OUT
QUIT
+13 NEW YSFMARRY
DO LIST^DIC(2,,.09,,,,YSCLSSN,"SSN",,,"YSFMARRY")
+14 SET YSCLDA=$GET(YSFMARRY("DILIST",2,1))
IF 'YSCLDA
SET YSCLER=" SSN does not exist at "
DO OUT
QUIT
+15 KILL YSFMARRY
DO LIST^DIC(603.01,,1,"I",,,YSCLDA,"C",,,"YSFMARRY")
+16 SET YSCLDA1=$GET(YSFMARRY("DILIST",2,1))
IF 'YSCLDA1
SET YSCLER=" SSN not in Clozapine file "
DO OUT
QUIT
+17 Begin DoDot:2
+18 SET DIE=603.01
SET DA=YSCLDA1
SET DR="2///"_YSCLWB
DO ^DIE
+19 ;06/15/05
SET YSCLER=" "_YSCLNM_" ("_$$GET1^DIQ(2,YSCLDA,.09)_") updated to "_$SELECT(YSCLWB="M":"Monthly",YSCLWB="W":"Weekly",YSCLWB="B":"Bi-weekly",1:"Unknown")_" at "
DO OUT
End DoDot:2
End DoDot:1
+20 GOTO EXIT
RESEND ;Trigger retransmission of Clozapine data
+1 XECUTE XMREC
+2 IF $LENGTH(XMRG,U)<1!($LENGTH(XMRG,U)>2)
SET YSCLER=" is an invalid date(s), RESEND not triggered at "
DO OUT
GOTO EXIT
+3 SET YSCLSTDT=$PIECE(XMRG,U,1)
+4 KILL %DT
SET X=YSCLSTDT
SET %DT="P"
DO ^%DT
IF Y=-1
SET YSCLER=" is an invalid start date, RESEND not triggered at "
DO OUT
GOTO EXIT
+5 SET X1=Y
SET X2=-1
DO C^%DTC
SET YSCLSTDT=X
+6 IF $LENGTH(XMRG,U)>1
SET YSCLEDDT=$PIECE(XMRG,U,2)
KILL %DT
SET X=YSCLEDDT
SET %DT="P"
DO ^%DT
IF Y=-1
SET YSCLER=" is an invalid end date, RESEND not triggered at "
DO OUT
GOTO EXIT
+7 SET X1=Y
SET X2=1
DO C^%DTC
SET YSCLEDDT=X
+8 IF $LENGTH(XMRG,U)=1
SET X1=YSCLSTDT
SET X2=2
DO C^%DTC
SET YSCLEDDT=X
+9 SET X1=YSCLEDDT
SET X2=YSCLSTDT
DO ^%DTC
IF X<0
SET YSCLER=" ending date cannot be less than start date, RESEND not triggered at "
DO OUT
GOTO EXIT
+10 NEW YSCLREX
+11 SET YSCLREX=1
+12 SET (YSCLTRDT,YSCLSDT)=YSCLSTDT
+13 DO REXMIT^YSCLTST5
+14 SET Y=YSCLSDT
XECUTE ^DD("DD")
SET YSCLER=" - Resend triggered (local task #"_$GET(ZTSK)_") by "_XMFROM_" for "_Y_" at "
DO OUT
+15 GOTO EXIT
DSET ;Set the day of the week for the roll-up to run.
+1 XECUTE XMREC
if XMER<0
QUIT
SET X=$TRANSLATE(XMRG,"- ","")
+2 SET YSOFF=$SELECT(X="SUNDAY":0,X="MONDAY":1,X="TUESDAY":2,X="WEDNESDAY":3,X="THURSDAY":4,X="FRIDAY":5,X="SATURDAY":6,1:7)
+3 IF YSOFF>6
DO ADD2TXT(X_" isn't a valid day of the week.")
GOTO EXIT
+4 ;S $P(^YSCL(603.03,1,0),U,2)=X
SET DIE="^YSCL(603.03,"
SET DA=1
SET DR="2////"_X
DO ^DIE
+5 DO ADD2TXT("Run day set to "_X)
+6 GOTO EXIT
+7 QUIT
DEBUG ;Turn debug mode on and off.
+1 IF YSCLSUB["DEBUG ON"
Begin DoDot:1
+2 DO ADD2TXT("Debug Mode is "_$SELECT(YSDEBUG:"already",1:"now")_" ON at "_YSCLSTN)
+3 ;S $P(^YSCL(603.03,1,0),U,3)=1
SET DIE="^YSCL(603.03,"
SET DA=1
SET DR="3////1"
DO ^DIE
End DoDot:1
+4 IF YSCLSUB["DEBUG OFF"
Begin DoDot:1
+5 DO ADD2TXT("Debug Mode is "_$SELECT('YSDEBUG:"already",1:"now")_" OFF at "_YSCLSTN)
+6 ;S $P(^YSCL(603.03,1,0),U,3)=0
SET DIE="^YSCL(603.03,"
SET DA=1
SET DR="3////0"
DO ^DIE
End DoDot:1
+7 GOTO EXIT
+8 ;
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,"YSCLXMSG",0))+1
SET ^(0)=C
SET ^TMP($JOB,"YSCLXMSG",C,0)=L
+3 QUIT
+4 ;
