Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YSCLSERV

YSCLSERV.m

Go to the documentation of this file.
  1. 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
  1. ; Reference to ^%ZOSF supported by IA #10096
  1. ; Reference to ^DPT supported by IA #10035
  1. ; Reference to ^DD("DD" supported by IA #10017
  1. ; Reference to ^PS(55 supported by IA #787
  1. ; Reference to ^PSDRUG supported by IA #25
  1. ; Reference to ^PSRX supported by IA #780
  1. ; Reference to ^VA(200 supported by IA #10060
  1. ; Reference to $$SITE^VASITE supported by IA #10112
  1. ; Reference to $$FMTE^XLFDT() supported by IA #10103
  1. ; Reference to ^PSDRUG supported by IA #221
  1. ; Reference to ^XMD supported by IA #10070
  1. ; Reference to ^DIC supported by DBIA #2051
  1. ; Reference to ^DIE supported by DBIA #2053
  1. ; Reference to ^DIQ supported by DBIA #2056
  1. ; Reference to ^DIK supported by DBIA #10013
  1. ; Reference to MIX^DIC1 supported by DBIA #10007
  1. ; Reference to FILE^DICN supported by DBIA #10009
  1. ; Reference to ^%DTC supported by DBIA #10000
  1. ; Reference to ^%DT supported by DBIA #10003
  1. ;
  1. START ;
  1. ;
  1. D DT^DICRW K ^TMP($J,"YSCLXMSG")
  1. S YSDEBUG=$$GET1^DIQ(603.03,1,3,"I")
  1. S YSCLST=$P($$SITE^VASITE,U,3)
  1. S YSCLSTN=$P($$SITE^VASITE,U,2)
  1. ;Determine station number
  1. I $G(PSCLOZ) G UNREG
  1. S X=XQSUB X ^%ZOSF("UPPERCASE") S YSCLSUB=Y
  1. I YSCLSUB["FILE603.01" G LKUP^YSCLSRV3
  1. D ADD2TXT($S(YSDEBUG:"DEBUG ",1:"")_YSCLSUB_" triggered at "_YSCLST_" by "_XMFROM_" on "_XQDATE)
  1. I YSCLSUB["DELETEALL" G DELALL
  1. ;The first line of the message tells who requested the action and when
  1. D
  1. .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")
  1. .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")
  1. .D ADD2TXT($S(YSDEBUG:"DEBUG ",1:"")_YSACTION_" at "_YSCLST)
  1. ;The second line tells when the server is activated and no data can be
  1. ;gathered from the MailMan message. This line gets replaced if the
  1. ;server finds something to do.
  1. I YSCLSUB["REMOVE"!(YSCLSUB["DELETE") G DELETE
  1. ;If the subject contains the word REMOVE or DELETE delete those entries from the list.
  1. I YSCLSUB["REPORT" G REPORT
  1. ;If the subject contains "REPORT" send a report of the currently registered patients to the Clozapine group on Forum
  1. ;I YSCLSUB["REBUILD" G REBUILD
  1. I YSCLSUB["RESEND" G RESEND
  1. I YSCLSUB["UPDATE" G UPDATE
  1. ;I YSCLSUB["CHECKSUM" G CSUM^YSCLSRV1
  1. I YSCLSUB["DATESET" G DSET
  1. I YSCLSUB["DEBUG" G DEBUG
  1. I YSCLSUB["PATIENT" G ^YSCLSRV3
  1. I YSCLSUB["LOCKOUT" G LOCK^YSCLSRV3
  1. I YSCLSUB="DEMOG RESET" G DEMOG^YSCLSRV3
  1. I YSCLSUB["AUTHORIZE" G AUTH^YSCLSRV3
  1. I YSCLSUB="OVERRIDE" G OVRRID^YSCLSRV2
  1. I YSCLSUB="CLAPI" G CLAPI^YSCLSRV2
  1. I YSCLSUB="CL1API" G CL1API^YSCLSRV2
  1. I YSCLSUB["DISCON" G DCON^YSCLSRV2
  1. F X XMREC Q:XMER<0 S XMRG=$TR(XMRG,"- ","") D
  1. . ;Verify that + of site number matches local site number
  1. . I XMRG'?2U5N1","9N1","1U S YSCLER=" is in error and was not added at " D OUT Q
  1. . I $P(XMRG,",")'?2U5N S YSCLER=" is not a valid Clozapine number " D OUT Q
  1. . I $P(XMRG,",",2)'?9N S YSCLER=" An SSN must be 9 numbers " D OUT Q
  1. . 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
  1. . ;Validate the format of the data in the message and report the error.
  1. . ;Do not add data for records where the SSN sent is not in the local database
  1. . S DIC="^DPT(",DIC(0)="X",D="SSN",X=$P(XMRG,",",2)
  1. . N YSFMARRY,YSFREQ D LIST^DIC(2,,.09,,,,X,"SSN",,,"YSFMARRY")
  1. . S DFN=$G(YSFMARRY("DILIST",2,1)) I DFN="" S YSCLER=" SSN does not exist at " D OUT Q
  1. . ;I '$D(^DPT("SSN",X)) S YSCLER=" SSN does not exist at " D OUT Q
  1. . K YSFMARRY D LIST^DIC(603.01,,1,,,,$P(XMRG,","),,,,"YSFMARRY")
  1. . I $D(YSFMARRY("DILIST","ID",1,1)) D D OUT Q
  1. . . S YSCLER=" Clozapine # is in use by "_YSFMARRY("DILIST","ID",1,1)_" at "
  1. . ;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
  1. . D MIX^DIC1 S YSCLPT=+Y I Y=-1 S YSCLER=" could not be added at " D OUT Q
  1. . ;Add the data and report any errors to the Roll-Up group at Forum.
  1. . K DD S DIC="^YSCL(603.01,",YSFREQ=$P(XMRG,",",3) S:YSFREQ="" YSFREQ="W" ; default to weekly
  1. . S X=$P(XMRG,","),DIC("DR")="1////"_YSCLPT_";2////"_$S("BMW"[YSFREQ:YSFREQ,1:"W"),DIC(0)="Z" K DO D FILE^DICN
  1. . K YSFMARRY D LIST^DIC(603.01,,".01E;1E;2E",,,,$P(XMRG,","),,,,"YSFMARRY")
  1. . I $D(YSFMARRY("DILIST","ID",1,1)) D
  1. . S YSCLER=" assigned to "_YSFMARRY("DILIST","ID",1,1)_" at " D OUT
  1. ;
  1. EXIT ;If all went well, report that too.
  1. S YSDEBUG=$$GET1^DIQ(603.03,1,3,"I")
  1. S XMDUN="NCCC LOGGER",XMDUZ=".5",XMSUB=$S(YSDEBUG:"DEBUG ",YSCLSUB["DEBUG":"DEBUG ",1:"")_YSCLST_" NCCC ENROLLER ("_$$NOW^XLFDT_")"
  1. ;
  1. ;/MZR -Begin modifications for YS*5.01*122
  1. K XMY N YSPROD,YSXMZ
  1. S YSPROD=$$GET1^DIQ(8989.3,1,501,"I")
  1. D:YSPROD
  1. . I 'YSDEBUG S XMY("G.CLOZAPINE ROLL-UP@DOMAIN.EXT")="" Q
  1. . S XMY("G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT")=""
  1. S:'YSPROD XMY("G.CLOZAPINE ROLL-UP")="",XMY("G.PSOCLOZ")=""
  1. ;/MZR - End modifications for YS*5.01*122
  1. ;
  1. D ; add mail group info to message text
  1. . D ADD2TXT(" ")
  1. . N G S G="G." F S G=$O(XMY(G)) Q:G="" D ADD2TXT(" Sent to: "_G)
  1. . D ADD2TXT(" "),ADD2TXT($J("*** END OF REPORT ***",45))
  1. ; Mail the errors and successes back to the Roll-Up group at Forum.
  1. D SENDMSG^XMXAPI(DUZ,XMSUB,$NA(^TMP($J,"YSCLXMSG")),.XMY,"",.YSXMZ)
  1. ;
  1. K ^TMP($J,"YSCLXMSG")
  1. K %,%DT,%H,D,DA,DD,DIC,DIE,DIK,RET,X,XMDUN,XMDUZ,XMER,XMFROM
  1. K XMREC,XMRG,XMSUB,XMTEXT,XMY,XMZ,XQDATE,XQSUB,Y,YSA,YSACTION,YSCLTYPE
  1. K YSCL28,YSCLA,YSCLAA,YSCLB,YSCLC,YSCLDA,YSCLDA1,YSCLDATA,YSCLDEA1
  1. K YSCLDFN,YSCLDM,YSCLDOC,YSCLDOM,YSCLDR,YSCLDRA,YSCLDRB,YSCLDTA,YSCLERR
  1. K YSCLDUZ,YSCLED,YSCLER,YSCLFDA,YSCLFRQ,YSCLLNT,YSCLNM,YSCLOVR,YSCLSITE
  1. K YSCLPT,YSCLRPT,YSCLSD1,YSCLSDT,YSCLSSN,YSCLST,YSCLSTN,YSCLSUB,YSCLTC
  1. K YSCLRX,YSCLSAND,YSCLWB,YSCLX,YSCLYN,YSDEBUG,YSI,YSOFF,YSPR,ZTQUEUED,ZTSK
  1. Q
  1. ;/RBN Begin mods - YS*5.01*122
  1. UNREG I $G(PSCLOZ) D Q
  1. . ;Verify that + of site number matches local site number
  1. . I XMRG'?1U4.6N1",".U1",".U1","4N S YSCLER=" is in error and was not added at " D OUT Q
  1. . I $P(XMRG,",")'?1U4.6N S YSCLER=" is not a valid Clozapine number " D OUT Q
  1. . I $P(XMRG,",",4)'?4N S YSCLER=" An SSN must be 4 numbers " D OUT Q
  1. . ;Validate the format of the data in the message and report the error.
  1. . ;Do not add data for records where the SSN sent is not in the local database
  1. . S DIC="^DPT(",DIC(0)="X",D="SSN",X=SSN
  1. . N YSFMARRY D LIST^DIC(2,,.09,,,,X,"SSN",,,"YSFMARRY")
  1. . S DFN=$G(YSFMARRY("DILIST",2,1)) I DFN="" S YSCLER=" SSN does not exist at " D OUT Q
  1. . K YSFMARRY D LIST^DIC(603.01,,1,,,,$P(XMRG,","),,,,"YSFMARRY")
  1. . I $D(YSFMARRY("DILIST","ID",1,1)) D D OUT Q
  1. . . S YSCLER=" Clozapine # is in use by "_YSFMARRY("DILIST","ID",1,1)_" at "
  1. . D MIX^DIC1 S YSCLPT=+Y I Y=-1 S YSCLER=" could not be added at " D OUT Q
  1. . ;Add the data and report any errors to the Roll-Up group at Forum.
  1. . K DD S DIC="^YSCL(603.01,",X=$P(XMRG,","),DIC("DR")="1////"_YSCLPT_";2////"_"W" K DO D FILE^DICN
  1. . K YSFMARRY D LIST^DIC(603.01,,1,,,,$P(XMRG,","),,,,"YSFMARRY")
  1. . I $D(YSFMARRY("DILIST","ID",1,1)) S YSCLER=" assigned to "_YSFMARRY("DILIST","ID",1,1)_" at " D OUT
  1. ;/RBN End mods - YS*5.01*122
  1. Q
  1. DELETE ;Allow the NCCC users to delete clozapine registration at the individual sites
  1. I XQSUB["DELETEALL" G DELALL
  1. F X XMREC Q:XMER<0 S XMRG=$TR(XMRG,"- ","") D
  1. . I XMRG="**++**DELETEALL**++**" D DELALL Q
  1. . N YSFMARRY D LIST^DIC(603.01,,1,,,,$P(XMRG,","),,,,"YSFMARRY")
  1. . I '$D(YSFMARRY("DILIST","ID",1,1)) S YSCLER=" "_$P(XMRG,",")_" is not registered at " D OUT Q
  1. . ;I '$D(^YSCL(603.01,"B",$P(XMRG,","))) S YSCLER=" "_$P(XMRG,",")_" is not registered at " D OUT Q
  1. . N YSFMARRY D LIST^DIC(2,,.09,,,,$P(XMRG,",",2),"SSN",,,"YSFMARRY")
  1. . S YSCLDFN=$G(YSFMARRY("DILIST",2,1)) I YSCLDFN="" S YSCLER=" "_$P(XMRG,",",2)_" is not a valid SSN at " D OUT Q
  1. . ;S YSCLDFN=$O(^DPT("SSN",$P(XMRG,",",2),"")) I YSCLDFN="" S YSCLER=" "_$P(XMRG,",")_" is not a valid SSN at " D OUT Q
  1. . K YSFMARRY D LIST^DIC(603.01,,1,"I",,,YSCLDFN,"C",,,"YSFMARRY")
  1. . I '$D(YSFMARRY("DILIST","ID",1,1)) S YSCLER=" "_$P(XMRG,",",2)_" is not registered at " D OUT Q
  1. . ;I '$D(^YSCL(603.01,"C",YSCLDFN)) S YSCLER=" "_$P(XMRG,",",2)_" is not registered at " D OUT Q
  1. . S YSCLA=YSFMARRY("DILIST",2,1) ;I YSCLA="" S YSCLER=" "_$P(XMRG,",")_" is not a valid entry at " D OUT Q
  1. . ;K ^YSCL(603.01,YSCLA),^YSCL(603.01,"B",$P(XMRG,","),YSCLA),^YSCL(603.01,"C",YSCLDFN,YSCLA)
  1. . S DIK="^YSCL(603.01,",DA=YSCLA D ^DIK
  1. . S YSCLER=" removed at " D OUT
  1. . ;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
  1. G EXIT
  1. DELALL ;Delete all patients in file 603.01
  1. ;
  1. D ADD2TXT("The deletion of ALL patients in File #603.01 has been disabled.")
  1. D ADD2TXT("No action taken.")
  1. G EXIT
  1. ;
  1. N YSFMARRY,DFN,YSCLA,YSCLREGN
  1. D LIST^DIC(603.01,,"1;2","I",,,,"C",,,"YSFMARRY")
  1. F I=1:1 Q:'$D(YSFMARRY("DILIST",2,I)) S YSCLA=YSFMARRY("DILIST",2,I) D:YSCLA
  1. . S DFN=YSFMARRY("DILIST",1,I),YSCLREGN=YSFMARRY("DILIST","ID",I,.01)
  1. . S YSCLER=YSCLREGN_", "_$$GET1^DIQ(2,DFN,.09)_", ("_YSFMARRY("DILIST","ID",I,2)_") deleted at " D OUT
  1. . S DIK="^YSCL(603.01,",DA=YSCLA D ^DIK ;K ^YSCL(603.01,YSCLA)
  1. Q
  1. REPORT ;send report of current registrations to the Clozapine group on Forum
  1. D REPORT^YSCLSRV2 G EXIT
  1. OUT ;
  1. D ADD2TXT(XMRG_YSCLER_YSCLST) Q
  1. ;Build the text for the return message here.
  1. REBUILD ;
  1. D REBUILD^YSCLSRV2 G EXIT
  1. UPDATE ;Update record with Monthly, Weekly or Bi-weekly status
  1. N YSARRAY D LIST^DIC(603.01,,,"I",,,,,,,"YSARRAY")
  1. F I=1:1 Q:'$D(YSARRAY("DILIST",2,I)) D
  1. .S YSARRAY(YSARRAY("DILIST",2,I))=YSARRAY("DILIST",1,I)
  1. .S YSARRAY("B",YSARRAY("DILIST",1,I))=YSARRAY("DILIST",2,I)
  1. K YSARRAY("DILIST")
  1. F X XMREC Q:XMER<0 S XMRG=$TR(XMRG,"- ","") D
  1. . I XMRG'?2U5N1","9N1","1U S YSCLER=" is in error and was not added at " D OUT Q
  1. . I $P(XMRG,",")'?2U5N S YSCLER=" is not a valid Clozapine number format " D OUT Q
  1. . I $P(XMRG,",",2)'?9N S YSCLER=" An SSN must be 9 numbers " D OUT Q
  1. . 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
  1. . S YSCLNM=$P(XMRG,","),YSCLSSN=$P(XMRG,",",2),YSCLWB=$P(XMRG,",",3)
  1. . I '$D(YSARRAY("B",YSCLNM)) S YSCLER=" does not exist at " D OUT Q
  1. . N YSFMARRY D LIST^DIC(2,,.09,,,,YSCLSSN,"SSN",,,"YSFMARRY")
  1. . S YSCLDA=$G(YSFMARRY("DILIST",2,1)) I 'YSCLDA S YSCLER=" SSN does not exist at " D OUT Q
  1. . K YSFMARRY D LIST^DIC(603.01,,1,"I",,,YSCLDA,"C",,,"YSFMARRY")
  1. . S YSCLDA1=$G(YSFMARRY("DILIST",2,1)) I 'YSCLDA1 S YSCLER=" SSN not in Clozapine file " D OUT Q
  1. . D
  1. . . S DIE=603.01,DA=YSCLDA1,DR="2///"_YSCLWB D ^DIE
  1. . . 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
  1. G EXIT
  1. RESEND ;Trigger retransmission of Clozapine data
  1. X XMREC
  1. I $L(XMRG,U)<1!($L(XMRG,U)>2) S YSCLER=" is an invalid date(s), RESEND not triggered at " D OUT G EXIT
  1. S YSCLSTDT=$P(XMRG,U,1)
  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
  1. S X1=Y,X2=-1 D C^%DTC S YSCLSTDT=X
  1. 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
  1. S X1=Y,X2=1 D C^%DTC S YSCLEDDT=X
  1. I $L(XMRG,U)=1 S X1=YSCLSTDT,X2=2 D C^%DTC S YSCLEDDT=X
  1. 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
  1. N YSCLREX
  1. S YSCLREX=1
  1. S (YSCLTRDT,YSCLSDT)=YSCLSTDT
  1. D REXMIT^YSCLTST5
  1. S Y=YSCLSDT X ^DD("DD") S YSCLER=" - Resend triggered (local task #"_$G(ZTSK)_") by "_XMFROM_" for "_Y_" at " D OUT
  1. G EXIT
  1. DSET ;Set the day of the week for the roll-up to run.
  1. X XMREC Q:XMER<0 S X=$TR(XMRG,"- ","")
  1. 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)
  1. I YSOFF>6 D ADD2TXT(X_" isn't a valid day of the week.") G EXIT
  1. S DIE="^YSCL(603.03,",DA=1,DR="2////"_X D ^DIE ;S $P(^YSCL(603.03,1,0),U,2)=X
  1. D ADD2TXT("Run day set to "_X)
  1. G EXIT
  1. Q
  1. DEBUG ;Turn debug mode on and off.
  1. I YSCLSUB["DEBUG ON" D
  1. . D ADD2TXT("Debug Mode is "_$S(YSDEBUG:"already",1:"now")_" ON at "_YSCLSTN)
  1. . S DIE="^YSCL(603.03,",DA=1,DR="3////1" D ^DIE ;S $P(^YSCL(603.03,1,0),U,3)=1
  1. I YSCLSUB["DEBUG OFF" D
  1. . D ADD2TXT("Debug Mode is "_$S('YSDEBUG:"already",1:"now")_" OFF at "_YSCLSTN)
  1. . S DIE="^YSCL(603.03,",DA=1,DR="3////0" D ^DIE ;S $P(^YSCL(603.03,1,0),U,3)=0
  1. G EXIT
  1. ;
  1. ADD2TXT(L) ; add line L to the Message text
  1. Q:'$D(L) I L="" S L=" "
  1. N C S C=$G(^TMP($J,"YSCLXMSG",0))+1,^(0)=C,^TMP($J,"YSCLXMSG",C,0)=L
  1. Q
  1. ;