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

PXRMLCR.m

Go to the documentation of this file.
  1. PXRMLCR ; SLC/PJH - Create Patient List from individual finding rule; 04/15/2014
  1. ;;2.0;CLINICAL REMINDERS;**4,6,12,26**;Feb 04, 2005;Build 404
  1. ;
  1. ; Called from PXRM PATIENT LIST CREATE protocol
  1. ;
  1. START N BEG,DUOUT,DTOUT,END,LIT,PXRMDPAT,PXRMLIST,PXRMNODE,PXRMRULE,PXRMTPAT
  1. ;Check if evaluation is disabled.
  1. I $D(^XTMP("PXRM_DISEV",0)) D Q
  1. . W !,"Reminder evaluation is disabled, cannot start patient list building."
  1. . H 2
  1. ;
  1. N TEXT
  1. ;Initialise
  1. K ^TMP("PXRMLCR",$J)
  1. ;Node for ^TMP lists created in PXRMRULE
  1. S PXRMNODE="PXRMRULE",LIT="Patient List"
  1. ;Reset screen mode
  1. W IORESET
  1. ;Set prompt text
  1. S TEXT="Select PATIENT LIST name: "
  1. ;Select Patient List
  1. LIST D PLIST(.PXRMLIST,TEXT,"") I $D(DUOUT)!$D(DTOUT) D Q
  1. . I $G(PXRMLIST)="" Q
  1. . I $P($G(^PXRMXP(810.5,PXRMLIST,0)),U,4)'="" Q
  1. . N DIK
  1. . S DA=PXRMLIST,DIK="^PXRMXP(810.5," D ^DIK
  1. ;
  1. SECURE ;option to secure the list
  1. K PATCREAT
  1. I $D(PATCREAT)=0 S PATCREAT="N" D ASK^PXRMXD(.PATCREAT,"Secure list?: ",2) Q:$D(DTOUT) G:$D(DUOUT) START
  1. ;
  1. PURGE ;Option to purge the list
  1. K PLISTPUG
  1. S PLISTPUG="N" D ASK^PXRMXD(.PLISTPUG,"Purge Patient List after 5 years?: ",5) Q:$D(DTOUT) G:$D(DUOUT) SECURE
  1. ;Select rule set.
  1. RULE D LRULE(.PXRMRULE) Q:$D(DTOUT) G:$D(DUOUT) LIST
  1. ;Select Date Range
  1. DATE D DATES^PXRMEUT(.BEG,.END,LIT) Q:$D(DTOUT) G:$D(DUOUT) RULE
  1. ;
  1. ;Ask whether to include deceased and test patients.
  1. DPAT S PXRMDPAT=$$ASKYN^PXRMEUT("N","Include deceased patients on the list")
  1. Q:$D(DTOUT) G:$D(DUOUT) DATE
  1. TPAT S PXRMTPAT=$$ASKYN^PXRMEUT("N","Include test patients on the list")
  1. Q:$D(DTOUT) G:$D(DUOUT) DPAT
  1. I $G(PXRMDEBG) D RUN^PXRMLCR(PXRMRULE,PXRMLIST,PXRMNODE,BEG,END,PXRMDPAT,PXRMTPAT) Q
  1. ;Build patient list in background
  1. N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
  1. S ZTDESC="Build Reminder Patient List"
  1. S ZTRTN="RUN^PXRMLCR(PXRMRULE,PXRMLIST,PXRMNODE,BEG,END,PXRMDPAT,PXRMTPAT)"
  1. S ZTSAVE("BEG")=""
  1. S ZTSAVE("END")=""
  1. S ZTSAVE("PATCREAT")=""
  1. S ZTSAVE("PXRMDPAT")=""
  1. S ZTSAVE("PXRMLIST")=""
  1. S ZTSAVE("PXRMNODE")=""
  1. S ZTSAVE("PXRMRULE")=""
  1. S ZTSAVE("PXRMTPAT")=""
  1. S ZTSAVE("PLISTPUG")=""
  1. S ZTIO=""
  1. ;
  1. ;Select and verify start date/time for task
  1. N DIR,DTOUT,DUOUT,MINDT,SDTIME,STIME,X,Y
  1. S MINDT=$$NOW^XLFDT
  1. W !,"Queue the "_ZTDESC_" for "_$P($G(^PXRMXP(810.5,PXRMLIST,0)),U)_": "
  1. S DIR("A",1)="Enter the date and time you want the job to start."
  1. S DIR("A",2)="It must be after "_$$FMTE^XLFDT(MINDT,"5Z")
  1. S DIR("A")="Start the task at: "
  1. S DIR(0)="DAU"_U_MINDT_"::RSX"
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) Q
  1. S SDTIME=Y
  1. ;
  1. ;Put the task into the queue.
  1. S ZTDTH=SDTIME
  1. D ^%ZTLOAD
  1. W !,"Task number ",ZTSK," queued." H 2
  1. EXIT Q
  1. ;
  1. HELP(CALL) ;General help text routine
  1. N HTEXT
  1. I CALL=1 D
  1. .S HTEXT(1)="Enter 'Y' to overwrite this existing list. Enter 'N' to"
  1. .S HTEXT(2)="use a different patient list name."
  1. ;
  1. I CALL=2 D
  1. .S HTEXT(1)="Enter 'Y' to make the list private or 'N' to make it public."
  1. .S HTEXT(2)="You can give other users access to your private lists in the Patient List Menu screens."
  1. ;
  1. I CALL=3 D
  1. .S HTEXT(1)="Enter Y to save the patient to a Reminder Patient List. Enter N to not save the output."
  1. ;
  1. I CALL=4 D
  1. .S HTEXT(1)="Enter Y to turn on debug output."
  1. .S HTEXT(2)="The debug output will send a series of MailMan messages to the requestor of the report"
  1. .S HTEXT(3)="-**WARNING**- the reminder report will take longer to run if you turn on this option!"
  1. D HELP^PXRMEUT(.HTEXT)
  1. Q
  1. ;
  1. PLIST(LIST,TEXT,IENO) ;Select Patient List
  1. N X,Y,DIC,DLAYGO
  1. PL1 S DIC=810.5,DLAYGO=DIC,DIC(0)="QAEMZL"
  1. S DIC("A")=TEXT
  1. S DIC("S")="I $P($G(^(100)),U)'=""N"""
  1. ;If this is a new entry save the creator, make the TYPE public and
  1. ;CLASS local.
  1. S DIC("DR")=".07///`"_DUZ_";.08///PUB;100///L"
  1. W !
  1. D ^DIC
  1. I X="" W !,"A patient list name must be entered" G PL1
  1. I X=(U_U) S DTOUT=1
  1. I Y=-1 S DUOUT=1
  1. I $D(DTOUT)!$D(DUOUT) Q
  1. ;
  1. ;I copy mode dissallow copy to same list
  1. I IENO=$P(Y,U) W !,"A patient list cannot be copied to itself." G PL1
  1. ;
  1. I ($P(Y,U,3)=1) S LIST=$P(Y,U) Q
  1. ;Check if OK to overwrite
  1. N OWRITE
  1. S OWRITE=$$ASKYN^PXRMEUT("N","Okay to overwrite "_$P(Y,U,2),"PXRMLCR",1)
  1. Q:$D(DTOUT) G:$D(DUOUT)!('OWRITE) PL1
  1. S OWRITE=$$LDELOK^PXRMEUT($P(Y,U,1))
  1. I 'OWRITE D G PL1
  1. . W !,"In order to overwrite a list you must be the creator or a Reminder Manager!"
  1. ;Return list ien
  1. S LIST=$P(Y,U)
  1. Q
  1. ;
  1. LRULE(RULE) ;Select List Rule
  1. N X,Y,DIC
  1. LR1 S DIC=810.4,DIC(0)="QAEMZ"
  1. S DIC("A")="Select LIST RULE SET: "
  1. ;Only allow rule sets with components
  1. S DIC("S")="I $P(^(0),U,3)=3"
  1. W !
  1. D ^DIC
  1. I X="" W !,"A list rule set name must be entered" G LR1
  1. I X=(U_U) S DTOUT=1
  1. I Y=-1 S DUOUT=1
  1. I $D(DTOUT)!$D(DUOUT) Q
  1. ;Return rule ien
  1. S RULE=$P(Y,U)
  1. ;Check that rule set is valid
  1. N ERROR,LR,LRTYPE,NL,OP,SEQ,SUB,TEMP,TEXT
  1. S SUB=$O(^PXRM(810.4,RULE,30,0))
  1. I SUB="" W !,"Rule set has no component rules" G LR1
  1. S (ERROR,SUB)=0,NL=1
  1. F S SUB=$O(^PXRM(810.4,RULE,30,SUB)) Q:'SUB D Q:ERROR
  1. .S TEMP=$G(^PXRM(810.4,RULE,30,SUB,0))
  1. .S SEQ=$P(TEMP,U,1),LR=$P(TEMP,U,2),OP=$P(TEMP,U,3)
  1. .I SEQ="" S NL=NL+1,TEXT(NL)=" Sequence is missing.",ERROR=1
  1. .I LR="" S NL=NL+1,TEXT(NL)=" List rule is missing.",ERROR=1
  1. .I OP="" S NL=NL+1,TEXT(NL)=" Operation is missing.",ERROR=1
  1. .;The Insert operation can only be used with finding rules.
  1. .I OP="F",LR'="" D
  1. ..S LRTYPE=$P(^PXRM(810.4,LR,0),U,3)
  1. ..I LRTYPE'=1 S NL=NL+1,TEXT(NL)=" Insert operation can only be used with finding rules.",ERROR=1
  1. I ERROR D G LR1
  1. .S TEXT(1)="The rule set is incomplete or incorrect:"
  1. .D EN^DDIOL(.TEXT)
  1. Q
  1. ;
  1. ;Build list and clear ^TMP files
  1. RUN(PXRMRULE,PXRMLIST,PXRMNODE,BEG,END,PXRMDPAT,PXRMTPAT) ;
  1. ;Process rule set and update final patient list
  1. D START^PXRMRULE(PXRMRULE,PXRMLIST,PXRMNODE,BEG,END,"","","",PXRMDPAT,PXRMTPAT,"")
  1. ;Clear ^TMP lists created for rule
  1. D CLEAR^PXRMRULE(PXRMRULE,PXRMNODE)
  1. Q
  1. ;
  1. REMOVE(IEN) ;
  1. S $P(^PXRM(810.4,IEN,0),U,10)=""
  1. Q "@1"
  1. ;