- 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 Feb 18, 2025@23:40:06 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 ;