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

PXRMORED.m

Go to the documentation of this file.
  1. PXRMORED ;SLC/AGP - Reminder Order Checks Editor ;10/17/2018
  1. ;;2.0;CLINICAL REMINDERS;**22,45**;Feb 04, 2005;Build 566
  1. ;
  1. Q
  1. ;
  1. ADD(INPUT,FILENUM) ;
  1. ;Add code is used when creating a new orderable item group
  1. N DA,DIC,Y,DTOUT,DUOUT,DTYP,DLAYGO,NEW
  1. S DIC=$S(FILENUM=801.1:"^PXD(801.1,",1:"^PXD(801,")
  1. ;Set the starting place for additions.
  1. I INPUT="E" S DIC(0)="AELQ",DLAYGO=FILENUM
  1. I INPUT="I" S DIC(0)="AEQ"
  1. S DIC("A")=$S(FILENUM=801.1:"Select Reminder Order Check Rule: ",1:"Reminder Order Check Item Group: ")
  1. D ^DIC
  1. I $D(DUOUT)!($D(DTOUT))!($D(DUOUT)) Q
  1. I Y=-1 K DIC Q
  1. S NEW=+$P(Y,U,3)
  1. I INPUT="I" D Q
  1. .N BY,DC,DHD,FLD,FR,HTEXT,IENN,NOW,TO
  1. .S FLDS="[PXRM ORDER CHECK ITEMS GROUP]"
  1. .S HTEXT="REMINDER ORDER CHECK ITEMS GROUP INQUIRY"
  1. .I FILENUM=801.1 D
  1. ..S FLDS="[PXRM ORDER CHECK RULE INQUIRY]"
  1. ..S HTEXT="REMINDER ORDER CHECK RULE INQUIRY"
  1. .D SET^PXRMINQ(Y,HTEXT)
  1. .;NAME OF PRINT TEMPLATE SHOULD BE CHANGED?
  1. .D DISP^PXRMINQ(DIC,FLDS)
  1. I INPUT="E" D EDIT(+Y,FILENUM,NEW)
  1. Q
  1. ;
  1. BUILD(FILENUM,REF,INPUT,ITEM,CNT,ALPHA,MATCH) ;
  1. ;build a list of orderable item group entries that contain ITEM
  1. N ARRAY,IEN,NAME
  1. K ^TMP($J,"PXRMORCL")
  1. S CNT=0
  1. S IEN=0 F S IEN=$O(^PXD(FILENUM,REF,ITEM,IEN)) Q:IEN'>0 D
  1. .S NAME=$P(^PXD(FILENUM,IEN,0),U)
  1. .S ARRAY(NAME)=IEN
  1. I '$D(ARRAY) W !,"No matching "_$S(FILENUM=801.1:"order check rules",1:"order check items group")_" found." Q 0
  1. ;
  1. ;build output display text in alpha array this loop is used to build
  1. ;a format for the DIR call can use in the SELECT line tag
  1. S NAME="" F S NAME=$O(ARRAY(NAME)) Q:NAME="" D
  1. .S IEN=ARRAY(NAME)
  1. .;
  1. .;if use for inquiry build temp global for inquiry
  1. .I INPUT="I" S ^TMP($J,"PXRMORCL",IEN)="" Q
  1. .;
  1. .S CNT=CNT+1,ALPHA(CNT)=$$RJ^XLFSTR(CNT,4," ")_" "_NAME
  1. .S MATCH(CNT,IEN)=NAME
  1. ;
  1. I INPUT="I" D
  1. .N BY,DIC,DHD,FLDS,FR,GBL,HTEXT,L,PXRMROOT,TO
  1. .S GBL=$S(FILENUM=801:"^PXD(801,",1:"^PXD(801.1,")
  1. .S (DIC,PXRMROOT)=GBL
  1. .S FLDS="[PXRM ORDER CHECK ITEMS GROUP]"
  1. .S HTEXT="REMINDER ORDER CHECK ITEMS GROUP INQUIRY"
  1. .I FILENUM=801.1 D
  1. ..S FLDS="[PXRM ORDER CHECK RULE INQUIRY]"
  1. ..S HTEXT="REMINDER ORDER CHECK RULE INQUIRY"
  1. .S L=0,L(0)=1,BY=.01,BY(0)="^TMP($J,""PXRMORCL""",FR="",TO=""
  1. .S DHD="@@"
  1. .D EN1^DIP
  1. K ^TMP($J,"PXRMORCL")
  1. Q
  1. ;
  1. DELTXT(IEN) ;
  1. ;delete the order check text called when the order check text
  1. ;is no longer valid for order check rule
  1. N DA,DIK,TEMP
  1. I '$D(^PXD(801.1,IEN,4)) Q
  1. W !,"Deleting order check output text"
  1. S DA(1)=IEN
  1. S DIK="^PXD(801.1,"_DA(1)_",4,"
  1. S DA=0 F S DA=$O(^PXD(801.1,DA(1),4,DA)) Q:DA'>0 S TEMP(DA)=""
  1. S DA=0 F S DA=$O(TEMP(DA)) Q:DA'>0 D ^DIK
  1. S ^PXD(801.1,IEN,5)=0
  1. Q
  1. ;
  1. EDIT(DA,FILENUM,NEW) ;
  1. ;PXRMNOIG is used in the template to control editing of fields for
  1. ;National Orderable Item Groups
  1. N DIDEL
  1. S DIDEL=FILENUM
  1. I FILENUM=801 D SMANEDIT^PXRMOCG(DA,NEW) Q
  1. I FILENUM=801.1 D SMANEDIT^PXRMOCR(DA,NEW) Q
  1. Q
  1. ;
  1. EN(INPUT,FILENUM) ;
  1. EN1 ;
  1. ;inital editor and inquiry entry point. This controls which
  1. ;way to select an order check group to edit, inquiry, or to add a new
  1. ;one. Input="E" editing/adding an entry Input="I" doing an inquiry
  1. N CNT,DIR,HTEXT,TAG,TYPE
  1. S TYPE=$S(FILENUM=801.1:"Order Check Rule",1:"Order Check Items Group")
  1. S CNT=0
  1. S CNT=CNT+1,HTEXT(CNT)="\\Select 'N' to select an "_TYPE_" name."
  1. I FILENUM=801 S CNT=CNT+1,HTEXT(CNT)="\\Select 'C' to select an "_TYPE_" by Drug Class"
  1. I FILENUM=801 S CNT=CNT+1,HTEXT(CNT)="\\Select 'D' to select an "_TYPE_" by Drug"
  1. I FILENUM=801 S CNT=CNT+1,HTEXT(CNT)="\\Select 'G' to select an "_TYPE_" by VA Generic"
  1. I FILENUM=801 S CNT=CNT+1,HTEXT(CNT)="\\Select 'I' to select an "_TYPE_" by an Imaging Type"
  1. I FILENUM=801 S CNT=CNT+1,HTEXT(CNT)="\\Select 'O' to select an "_TYPE_" by an Orderable Item"
  1. I FILENUM=801 S CNT=CNT+1,HTEXT(CNT)="\\Select 'P' to select an "_TYPE_" by an VA Product"
  1. I FILENUM=801 S CNT=CNT+1,HTEXT(CNT)="\\Select 'R' to select an "_TYPE_" by an Order Check Rule"
  1. I FILENUM=801.1 S CNT=CNT+1,HTEXT(CNT)="\\Select 'R' to select an "_TYPE_" by a Reminder Definition."
  1. I FILENUM=801.1 S CNT=CNT+1,HTEXT(CNT)="\\Select 'T' to select an "_TYPE_" by a Reminder Term."
  1. S CNT=CNT+1,HTEXT(CNT)="\\Select Q to Quit"
  1. S DIR(0)="SB^"
  1. ;
  1. S CNT=1
  1. S DIR("A")="Select Reminder "_TYPE_" by"
  1. S DIR("A",CNT)=" N: "_$$UP^XLFSTR(TYPE)_" NAME"
  1. I FILENUM=801 S CNT=CNT+1,DIR("A",CNT)=" C: VA DRUG CLASS"
  1. I FILENUM=801 S CNT=CNT+1,DIR("A",CNT)=" D: DRUG"
  1. I FILENUM=801 S CNT=CNT+1,DIR("A",CNT)=" G: VA GENERIC"
  1. I FILENUM=801 S CNT=CNT+1,DIR("A",CNT)=" I: IMAGING TYPE"
  1. I FILENUM=801 S CNT=CNT+1,DIR("A",CNT)=" O: ORDERABLE ITEM"
  1. I FILENUM=801 S CNT=CNT+1,DIR("A",CNT)=" P: VA Product"
  1. I FILENUM=801 S CNT=CNT+1,DIR("A",CNT)=" R: ORDER CHECK RULE"
  1. I FILENUM=801.1 S CNT=CNT+1,DIR("A",CNT)=" R: REMINDER DEFINITION"
  1. I FILENUM=801.1 S CNT=CNT+1,DIR("A",CNT)=" T: REMINDER TERM"
  1. S CNT=CNT+1,DIR("A",CNT)=" Q: QUIT"
  1. S CNT=CNT+1,DIR("A",CNT)=" "
  1. I FILENUM=801 S DIR(0)=DIR(0)_"N:ORDER CHECK ITEM GROUP NAME;C:VA DRUG CLASS;D:DRUG;G:VA GENERIC;I:IMAGING TYPE;O:ORDERABLE ITEM;P:VA PRODUCT;R:ORDER CHECK RULE;Q:QUIT"
  1. I FILENUM=801.1 S DIR(0)=DIR(0)_"N:ORDER CHECK RULE NAME;R:REMINDER DEFINITION;T:REMINDER TERM;Q:QUIT"
  1. ;
  1. S DIR("B")="N"
  1. S DIR("?")="Select one of the above option or '^' to quit. Enter ?? for detail help."
  1. S DIR("??")=U_"D HELP^PXRMEUT(.HTEXT)"
  1. W !,"Select Reminder "_TYPE_" by one of the following:",!!
  1. D ^DIR
  1. I Y="Q" Q
  1. I Y[U Q
  1. I $D(DTOUT) Q ;PXRM*2*22 RMS
  1. D FIND(Y,INPUT,FILENUM)
  1. G EN1
  1. Q
  1. ;
  1. FIND(TYPE,INPUT,FILENUM) ;
  1. FIND1 ;
  1. ;general file look-up
  1. N DIC,IEN,ROOT,SCREEN,Y
  1. I TYPE="N" D ADD(INPUT,FILENUM) Q
  1. I TYPE="C" S ROOT="^PS(50.605,"
  1. I TYPE="D" S ROOT="^PSDRUG("
  1. I TYPE="G" S ROOT="^PSNDF(50.6,"
  1. I TYPE="I" S ROOT="^RA(79.2,"
  1. I TYPE="O" S ROOT="^ORD(101.43,"
  1. I TYPE="P" S ROOT="^PSNDF(50.68,"
  1. I TYPE="T" S ROOT="^PXRMD(811.5,"
  1. I TYPE="R" S ROOT=$S(FILENUM=801.1:"^PXD(811.9,",1:"^PXD(801.1,")
  1. S DIC=ROOT
  1. S DIC(0)="AEMOQ"
  1. I ROOT="^PXD(811.9," S DIC("S")="I $P($G(^(100)),U,4)[""O"""
  1. D ^DIC
  1. I ($D(DTOUT))!($D(DUOUT))!(Y=-1) Q
  1. I TYPE="N",+Y>0 D EDIT(+Y,801,0) Q
  1. ;TYPE matches the xref on file 801.
  1. D SELECT(TYPE,INPUT,+Y,FILENUM)
  1. K Y G FIND1
  1. Q
  1. ;
  1. HASDEF(DA) ;
  1. I $P($G(^PXD(801.1,DA,3)),U)>0 Q 1
  1. Q 0
  1. ;
  1. HELP(TYPE) ;
  1. N LC,NIN,NLINES,NOUT,TEXT,TEXTIN,TEXTOUT
  1. I TYPE=1 D
  1. .S TEXTIN(1)="Select 'Yes' to add all orderable items by a specific drug class."
  1. .S TEXTIN(2)="After the orderable items are added the user will be able to do additional edits to the orderable item list."
  1. .S TEXTIN(3)="\\Select 'No' if not adding medication orderable items,or not adding all orderable items for a drug class."
  1. .S NIN=3
  1. I '$D(TEXTIN) Q
  1. D FORMAT^PXRMTEXT(1,75,NIN,.TEXTIN,.NLINES,.TEXT)
  1. ;write out the output
  1. F LC=1:1:NLINES D
  1. .S CNT=CNT+1 W !,TEXT(LC)
  1. Q
  1. ;
  1. INVALDIS(VALUE) ;
  1. ;is DISPLAY NAME field value in REMINDER ORDER CHECK RULES file invalid?
  1. ;1 = invalid display name, 0 = valid display name
  1. I $G(PXRMINST)=1!($G(PXRMEXCH)=1) Q 0
  1. N RETURN
  1. S RETURN=1,VALUE=$G(VALUE)
  1. I $L(VALUE)>=3,$L(VALUE)<=64 D
  1. .I '$D(^PXD(801.1,"D",VALUE))!($D(^PXD(801.1,"D",VALUE))&($G(DIUTIL)="VERIFY FIELDS")) S RETURN=0
  1. Q RETURN
  1. ;
  1. NAT(DA,FILENUM) ;
  1. ;used by the input template to control editing of fields
  1. I $G(DIUTIL)="VERIFY FIELDS" Q 1
  1. I $G(PXRMINST)=1 Q 0
  1. I $P($G(^PXD(FILENUM,DA,100)),U)="N" Q 1
  1. Q 0
  1. ;
  1. RULEUSEB(RULE) ;
  1. N IEN,NAME
  1. I '$D(^PXD(801,"R",RULE)) Q
  1. W !,"Rule in use by:"
  1. S IEN=0 F S IEN=$O(^PXD(801,"R",RULE,IEN)) Q:IEN'>0 D
  1. .S NAME=$P($G(^PXD(801,IEN,0)),U) Q:NAME=""
  1. .W !," "_NAME
  1. Q
  1. ;
  1. RULEIUSE(RULE) ;
  1. I $D(^PXD(801,"R",RULE)) Q 0
  1. Q 1
  1. ;
  1. ITEMINQ ;
  1. N DIEW,DIWF,DIWL,NAME,PAD,X
  1. S DIWF="C80",DIWL=2
  1. S NAME="",PAD=" "
  1. F S NAME=$O(^PXD(801,D0,1.5,"OCIO",NAME)) Q:NAME="" D
  1. .S X=PAD_NAME
  1. .D ^DIWP
  1. Q
  1. ;
  1. RULEINQ(FILENUM) ;
  1. ;this entry point is used to build the RULE multiple output for the
  1. ;INQUIRY option
  1. ;
  1. N DIEW,DIWF,DIWL,PAD,RIEN,RJC,NODE,NODE100,X
  1. K ^TMP($J,"W")
  1. I FILENUM=801 S RIEN=$G(^PXD(801,D0,3,D1,0))
  1. I FILENUM=801.1 S RIEN=D0
  1. D WPFORMAT(RIEN,1)
  1. D WPFORMAT(RIEN,4)
  1. S RJC=20,PAD=" "
  1. S DIWF="C80",DIWL=2
  1. S NODE=$G(^PXD(801.1,RIEN,0))
  1. S X=$$RJ^XLFSTR("Rule Name:",RJC,PAD)
  1. S X=X_" "_$P(NODE,U)
  1. D ^DIWP
  1. S X=$$RJ^XLFSTR("Display Name:",RJC,PAD)
  1. S X=X_" "_$P(NODE,U,2)
  1. D ^DIWP
  1. S NODE100=$G(^PXD(801.1,RIEN,100))
  1. S X=$$RJ^XLFSTR("Class:",RJC,PAD)
  1. S X=X_" "_$S($P(NODE100,U)="L":"Local",$P(NODE100,U)="V":"VISN",1:"National")
  1. D ^DIWP
  1. S X=$$RJ^XLFSTR("Sponsor:",RJC,PAD)
  1. I $P(NODE100,U,2)>0 S X=X_" "_$P($G(^PXRMD(811.6,$P(NODE100,U,2),0)),U)
  1. D ^DIWP
  1. S X=$$RJ^XLFSTR("Review Date:",RJC,PAD)
  1. I $P(NODE100,U,3)>0 S X=X_" "_$$FMTE^XLFDT($P(NODE100,U,3))
  1. D ^DIWP
  1. S X=$$RJ^XLFSTR("Status:",RJC,PAD)
  1. S X=X_" "_$S($P(NODE,U,3)="I":"Inactive",$P(NODE,U,3)="P":"Production",$P(NODE,U,3)="T":"Testing",$P(NODE,U,3)="N":"Notification")
  1. D ^DIWP
  1. S X=$$RJ^XLFSTR("Severity:",RJC,PAD)
  1. S X=X_" "_$S($P(NODE,U,5)=1:"High",$P(NODE,U,5)=2:"Medium",1:"Low")
  1. D ^DIWP
  1. I $P($G(^PXD(801.1,RIEN,2)),U)'="" D Q
  1. .S X=" " D ^DIWP
  1. .S NODE=$G(^PXD(801.1,RIEN,2))
  1. .S X=$$RJ^XLFSTR("Reminder Term:",RJC,PAD)
  1. .S X=X_" "_$P($G(^PXRMD(811.5,$P(NODE,U),0)),U)
  1. .D ^DIWP
  1. .S X=$$RJ^XLFSTR("Reminder Term Status:",RJC,PAD)
  1. .S X=X_" "_$S($P(NODE,U,2)=1:"TRUE",1:"FALSE")
  1. .D ^DIWP
  1. .D WPOUT(4,"Order Check Text",RJC,PAD)
  1. .D WPOUT(1,"Rule Description",RJC,PAD)
  1. S X=" " D ^DIWP
  1. S NODE=$G(^PXD(801.1,RIEN,3)) I +$P(NODE,U)=0 G RULEINQX
  1. S X=$$RJ^XLFSTR("Reminder Definition:",RJC,PAD)
  1. S X=X_" "_$P($G(^PXD(811.9,$P(NODE,U),0)),U)
  1. D ^DIWP
  1. S X=$$RJ^XLFSTR("Definition Status:",RJC,PAD)
  1. S X=X_" "_$S($P(NODE,U,2)="D":"Due",$P(NODE,U,2)="A":"Applicable",1:"N/A")
  1. D ^DIWP
  1. S X=$$RJ^XLFSTR("Output Text:",RJC,PAD)
  1. S X=X_" "_$S($P(NODE,U,3)="O":"Order Check Text Only",$P(NODE,U,3)="D":"Definition Text Only",1:"Both Order Check and Definition Text")
  1. D ^DIWP
  1. D WPOUT(4,"Order Check Text",RJC,PAD)
  1. D WPOUT(1,"Rule Description",RJC,PAD)
  1. RULEINQX ;
  1. K ^TMP($J,"W")
  1. Q
  1. ;
  1. RNXHELP ;Executable help for RULE NAME.
  1. N TEXT
  1. S TEXT(1)="Select an existing rule assigned to the order check items group to edit the rule."
  1. D EN^DDIOL(.TEXT)
  1. Q
  1. ;
  1. SELECT(REF,INPUT,ITEM,FILENUM) ;
  1. ;if requested to find an orderable item group by Orderable, Definition,
  1. ;term this line tag is used
  1. ;
  1. N ALPHA,CNT,DIROUT,DIRUT,DIR,DONE,MATCH,NAME
  1. ;I REF="C"!(REF="D")!(REF="G") D
  1. ;.S ITEM=ITEM_$S(REF="D":";PSDRUG(",REF="C":";PS(50.605,",REF="G":";PSNDF(50.6,",1:"")
  1. ;.S REF="P"
  1. I REF="C"!(REF="D")!(REF="G")!(REF="I")!(REF="O")!(REF="P") D
  1. .S ITEM=ITEM_$S(REF="D":";PSDRUG(",REF="C":";PS(50.605,",REF="G":";PSNDF(50.6,",REF="O":";ORD(101.43,",REF="I":";RA(79.2,",REF="P":";PSNDF(50.68,",1:"")
  1. .S REF="O"
  1. ;build array by name of rules containing ITEM
  1. D BUILD(FILENUM,REF,INPUT,ITEM,.CNT,.ALPHA,.MATCH)
  1. ;
  1. I INPUT="I" Q
  1. I CNT=0 Q
  1. S DONE=0
  1. ;allow multiple edits of different orderable item groups
  1. F Q:DONE D
  1. .M DIR("A")=ALPHA
  1. .S DIR("A")="Select a reminder orderable item group"
  1. .S DIR(0)="NO^1:"_CNT
  1. .W !!,"Select a reminder order check group from the following list:"
  1. .D ^DIR
  1. .I (Y="")!(Y["^") S DONE=1 Q
  1. .I $D(DIROUT)!($D(DIRUT))!($D(DUOUT))!($D(DTOUT)) S DONE=1 Q
  1. .S IEN=$O(MATCH(Y,"")) I IEN=0 Q
  1. .D EDIT(IEN,FILENUM,0)
  1. .;rebuild build array by name of rules containing ITEM
  1. .D BUILD(REF,INPUT,ITEM,.CNT,.ALPHA,.MATCH)
  1. Q
  1. ;
  1. SNOCTL(DA) ;
  1. ;set the number of lines in the order check text multiple
  1. N NUM,NOLC,PIPECNT
  1. S (NUM,NOLC,PIPECNT)=0
  1. F S NUM=$O(^PXD(801.1,DA,4,NUM)) Q:NUM'>0 D
  1. .S PIPECNT=PIPECNT+$L(^PXD(801.1,DA,4,NUM,0),"|")-1
  1. .S NOLC=NOLC+1
  1. I (PIPECNT#2)=1 D TIUOBJW^PXRMFNFT("Order Check Text",PIPECNT)
  1. I PIPECNT>0 S NOLC=NOLC_"T"
  1. S ^PXD(801.1,DA,5)=NOLC
  1. Q
  1. ;
  1. ;STATUS(Y) ;
  1. ;I $D(PXRMINST) Q 1
  1. ;I Y="N" Q 0
  1. ;Q 1
  1. ;
  1. WPFORMAT(RIEN,SUB) ;
  1. ;use for inquiry, build word-processing fields to be used later
  1. ;because of DIWP API
  1. ;
  1. N CNT,NLINES,NUM,TEXTIN,TEXTOUT,TITLE
  1. I '$D(^PXD(801.1,RIEN,SUB)) Q
  1. S CNT=0,NUM=0
  1. F S CNT=$O(^PXD(801.1,RIEN,SUB,CNT)) Q:CNT'>0 D
  1. .S NUM=NUM+1,TEXTIN(NUM)=$G(^PXD(801.1,RIEN,SUB,CNT,0))
  1. D FORMAT^PXRMTEXT(22,74,NUM,.TEXTIN,.NLINES,.TEXTOUT)
  1. S ^TMP($J,"W",SUB)=NLINES
  1. F CNT=1:1:NLINES D
  1. .S ^TMP($J,"W",SUB,CNT)=TEXTOUT(CNT)
  1. Q
  1. ;
  1. WPOUT(SUB,TITLE,RJC,PAD) ;
  1. ;print out word processing field text used by INQUIRY
  1. I '$D(^TMP($J,"W",SUB)) Q
  1. N IND,PADS,X
  1. S PADS=" "
  1. S X=$$RJ^XLFSTR(TITLE_":",RJC,PAD)
  1. D ^DIWP
  1. F IND=1:1:^TMP($J,"W",SUB) D
  1. .S X=^TMP($J,"W",SUB,IND)
  1. .D ^DIWP
  1. Q
  1. ;