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

PXRMSEL.m

Go to the documentation of this file.
  1. PXRMSEL ; SLC/PJH - PXRM Selection ;09/07/2012
  1. ;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404
  1. ;
  1. ;Selection screen for all dialog files
  1. ;
  1. START(HEADER,PXRMGTYP,PXRMNAM) ;
  1. N PXRMREAD,PXRMSHD,PXRMSRC,PXRMVARM
  1. N VALM,VALMAR,VALMBCK,VALMBG,VALMCNT,VALMHDR,VALMSG,X,XMZ
  1. S X="IORESET"
  1. D ENDR^%ZISS,EN^VALM("PXRM SELECTION")
  1. W IORESET
  1. D KILL^%ZISS
  1. Q
  1. ;
  1. ;Labels called from list 'PXRM SELECTION'
  1. ;
  1. ;Add new entry
  1. ADD ;
  1. N ANS,ARRAY,ARRAYN,DIROUT,DIRUT,DTOUT,DUOUT
  1. ;Health factor resolutions
  1. I PXRMGTYP="SHFR" D Q:$D(DTOUT)!$D(DUOUT) Q:ANS="A"
  1. .D ^PXRMSEL2 S:$D(DUOUT) VALMBCK="R"
  1. ;Add entry
  1. D ADD^PXRMGEDT(PXRMGTYP),INIT
  1. Q
  1. ;
  1. ;Copy any dialog
  1. COPY D ANY^PXRMDCPY
  1. D:PXRMGTYP="DLGE" INIT
  1. Q
  1. ;
  1. ;Copy selected reminder dialog
  1. COPYS N DIC,DUOUT,DTOUT,DIROUT,DIRUT,X,Y
  1. D SEL^PXRMDCPY(PXRMDIEN,"")
  1. Q
  1. ;
  1. ;Change dialog view
  1. CHNG K PXRMBG D SEL^PXRMSEL2(.PXRMDTYP),INIT
  1. Q
  1. ;
  1. ;Change reminder view
  1. CHNGR(VIEW) ;
  1. S $E(PXRMVIEW)=VIEW K PXRMBG
  1. D INIT
  1. Q
  1. ;
  1. ;Toggle view name/print name
  1. CHNGV N VIEW
  1. S VIEW=$E(PXRMVIEW,2)
  1. I VIEW="P" S $E(PXRMVIEW,2)="N"
  1. I VIEW="N" S $E(PXRMVIEW,2)="P"
  1. D INIT
  1. Q
  1. ;
  1. ;Change between dialog view and reminder view
  1. DIDL(VIEW) ;
  1. K PXRMBG S PXRMGTYP=VIEW
  1. D INIT
  1. Q
  1. ;
  1. EXIT ;Exit code
  1. D CLEAN^VALM10,FULL^VALM1
  1. S VALMBCK="Q"
  1. K ^TMP("PXRMSEL",$J)
  1. Q
  1. ;
  1. HDR ; Header code
  1. S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
  1. ;Non-Dialog options
  1. I PXRMGTYP'["DLG" S VALMHDR(1)=HEADER Q
  1. ;Dialog Options
  1. S VALM("TITLE")=PXRMHD,VALMHDR(1)=PXRMSHD
  1. Q
  1. ;
  1. HELP ;Help code
  1. N ORU,ORUPRMT,XQORM,PXRMTAG S PXRMTAG=PXRMGTYP
  1. D EN^VALM("PXRM DIALOG MAIN HELP")
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. INIT ;Init
  1. D CLEAN^VALM10
  1. S VALMCNT=0
  1. D BUILD
  1. D XQORM
  1. ;
  1. ;Set header and title for dialog options
  1. I PXRMGTYP["DLG" D
  1. .S PXRMHD="Dialog List",PXRMSHD="DIALOG VIEW ("
  1. .I PXRMGTYP="DLGE" D
  1. ..I PXRMDTYP="E" S PXRMSHD=PXRMSHD_"DIALOG ELEMENTS)"
  1. ..I PXRMDTYP="F" S PXRMSHD=PXRMSHD_"FORCED VALUES)"
  1. ..I PXRMDTYP="G" S PXRMSHD=PXRMSHD_"DIALOG GROUPS)"
  1. ..I PXRMDTYP="P" S PXRMSHD=PXRMSHD_"ADDITIONAL PROMPTS)"
  1. ..I PXRMDTYP="S" S PXRMSHD=PXRMSHD_"RESULT GROUPS)"
  1. ..I PXRMDTYP="T" S PXRMSHD=PXRMSHD_"RESULT ELEMENT)"
  1. .I PXRMGTYP="DLG" D
  1. ..S PXRMSHD=PXRMSHD_"REMINDER DIALOGS - "
  1. ..I $E(PXRMVIEW,2)="N" S PXRMSHD=PXRMSHD_"SOURCE REMINDER NAME)"
  1. ..I $E(PXRMVIEW,2)="P" S PXRMSHD=PXRMSHD_"SOURCE REMINDER PRINT NAME)"
  1. .I PXRMGTYP="DLGR" D
  1. ..S PXRMSHD="REMINDER VIEW ("
  1. ..I PXRMVIEW="AN" S PXRMSHD=PXRMSHD_"ALL REMINDERS BY NAME)"
  1. ..I PXRMVIEW="AP" S PXRMSHD=PXRMSHD_"ALL REMINDERS BY PRINT NAME)"
  1. ..I PXRMVIEW="LN" S PXRMSHD=PXRMSHD_"LINKED REMINDERS BY NAME)"
  1. ..I PXRMVIEW="LP" S PXRMSHD=PXRMSHD_"LINKED REMINDERS BY PRINT NAME)"
  1. .;Restore original place
  1. .S:$G(PXRMBG) VALMBG=PXRMBG
  1. .S VALMHDR(1)=PXRMSHD,VALM("TITLE")=PXRMHD
  1. ;
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;
  1. BUILD ;Build selection list
  1. ;
  1. D ^PXRMSEL1
  1. Q
  1. ;
  1. LIST ;List All option
  1. W IORESET
  1. I PXRMGTYP["DLG" D ALL^PXRMDLST
  1. ;I PXRMGTYP="DTAX" D ALL^PXRMTDLG
  1. I PXRMGTYP="FIP" D ALL^PXRMFIP
  1. I PXRMGTYP="FPAR" D ALL^PXRMFLST
  1. I PXRMGTYP="RCAT" D ALL^PXRMCLST
  1. I PXRMGTYP="RESN" D ALL^PXRMSLST
  1. I PXRMGTYP="SHFR" D ALL^PXRMSHF
  1. ;
  1. N DIR S DIR(0)="E" D ^DIR
  1. ;
  1. D XQORM
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. PEXIT ;PXRM SELECTION MENU protocol exit code
  1. S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
  1. ;Reset after page up/down etc
  1. D XQORM
  1. Q
  1. ;
  1. SEL ;PXRM SELECT ITEM validation
  1. N ERR,IEN,SEL
  1. S VALMBCK="",SEL=+$P(XQORNOD(0),"=",2)
  1. ;Invalid selection
  1. I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D Q
  1. .W $C(7),!,SEL_" is not a valid item number." H 2
  1. .S VALMBCK="R"
  1. ;Valid selection
  1. S IEN=$O(@VALMAR@("IDX",SEL,"")) Q:'IEN
  1. S VALMBCK="Q",@PXRMNAM=IEN
  1. ;Save place - reminder link only
  1. I PXRMGTYP["DLG" S PXRMBG=VALMBG
  1. Q
  1. ;
  1. XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM SELECTION ITEM",0))_U_"1:"_VALMCNT
  1. S XQORM("A")="Select Item: "
  1. ;For finding type parameters dissallow add option
  1. I ((PXRMGTYP="FPAR")&(+$G(PXRMINST)=0))!(PXRMGTYP="DTAX") D
  1. .N FMENU
  1. .S FMENU=$O(^ORD(101,"B","PXRM FINDING SELECTION MENU",0))_";ORD(101,"
  1. .I FMENU S XQORM("HIJACK")=FMENU
  1. ;For dialog edit allow extra options
  1. I PXRMGTYP="DLGE" D
  1. .N FMENU
  1. .S FMENU=$O(^ORD(101,"B","PXRM DIALOG SELECTION MENU (DLGE)",0))_";ORD(101,"
  1. .I FMENU S XQORM("HIJACK")=FMENU
  1. ;For reminder dialog edit allow change view
  1. I PXRMGTYP="DLG" D
  1. .N FMENU
  1. .S FMENU=$O(^ORD(101,"B","PXRM DIALOG SELECTION MENU (DLG)",0))_";ORD(101,"
  1. .I FMENU S XQORM("HIJACK")=FMENU
  1. ;Reminder to dialog link
  1. I PXRMGTYP="DLGR" D
  1. .N FMENU
  1. .S FMENU=$O(^ORD(101,"B","PXRM DIALOG/REMINDER MENU",0))_";ORD(101,"
  1. .I FMENU S XQORM("HIJACK")=FMENU
  1. Q
  1. ;
  1. ;Select single HF or all HF's for the reminder
  1. ;---------------------------------------------
  1. ZOPT(TYPE) ;
  1. N X,Y
  1. K DIROUT,DIRUT,DTOUT,DUOUT
  1. S DIR(0)="S"_U_"I:Individual Health Factor;"
  1. S DIR(0)=DIR(0)_"A:All Health Factors for a Selected Reminder;"
  1. S DIR("A")="SELECTION OPTION"
  1. S DIR("B")="I"
  1. S DIR("?")="Select from the codes displayed. For detailed help type ??"
  1. S DIR("??")=U_"D ZHELP^PXRMSEL(1)"
  1. D ^DIR K DIR
  1. I $D(DIROUT) S DTOUT=1
  1. I $D(DTOUT)!($D(DUOUT)) Q
  1. S TYPE=Y
  1. Q
  1. ;
  1. ;Reminder selection
  1. ;------------------
  1. ZREM(ARRAY) ;
  1. N X,Y,CNT,FSUB,FHF,FIND,FNAM,FOUND,REM
  1. K DIROUT,DIRUT,DTOUT,DUOUT
  1. S FOUND=0
  1. W !
  1. F D Q:$D(DTOUT) Q:$D(DUOUT) Q:FOUND
  1. .S DIC=811.9,DIC(0)="AEMQZ"
  1. .D ^DIC K DIC S:X=(U_U) DTOUT=1 Q:$D(DTOUT)!$D(DUOUT)!(+Y=-1)
  1. .;Reminder ien
  1. .S REM=$P(Y,U) Q:'REM
  1. .;Get health factor findings on this reminder
  1. .S FSUB=0
  1. .F S FSUB=$O(^PXD(811.9,REM,20,FSUB)) Q:'FSUB D
  1. ..S FIND=$P($G(^PXD(811.9,REM,20,FSUB,0)),U)
  1. ..Q:$P(FIND,";",2)'="AUTTHF("
  1. ..S FHF=$P(FIND,";") Q:'FHF
  1. ..S FNAM=$P($G(^AUTTHF(FHF,0)),U) Q:FNAM=""
  1. ..;Save array used by PXRMGEDT
  1. ..S FOUND=FOUND+1
  1. ..S ARRAY(FNAM)=FHF,ARRAYN(FHF)=""
  1. .I 'FOUND W !!,"No health factor findings on this reminder",! Q
  1. .S FNAM=""
  1. .W !!,"HEALTH FACTORS:",!
  1. .F S FNAM=$O(ARRAY(FNAM)) Q:FNAM="" D
  1. ..S FHF=$P(ARRAY(FNAM),U)
  1. ..W !,FNAM W:$D(^PXRMD(801.95,FHF,0)) " (Resolution defined)"
  1. .W !
  1. Q
  1. ;
  1. ;Reminders Health Factors
  1. ;------------------------
  1. ZSKIP N ANS,FNAM,FHF,EXISTS,TEXT
  1. S FNAM=""
  1. F S FNAM=$O(ARRAY(FNAM)) Q:FNAM="" D Q:$D(DUOUT)!$D(DTOUT)
  1. .S FHF=ARRAY(FNAM),EXISTS=$D(^PXRMD(801.95,FHF,0))
  1. .I 'EXISTS S TEXT="ADD resolution status for "_FNAM_": "
  1. .I EXISTS S TEXT="MODIFY resolution status for "_FNAM_": "
  1. .;Option to ADD/MODIFY
  1. .D ZASK(.ANS,TEXT) Q:$D(DTOUT)!$D(DUOUT) Q:(ANS'="Y")
  1. .;Force entry of HF into 801.95
  1. .I 'EXISTS D
  1. ..N DA,DIC,DIK,DR
  1. ..;Store the unique name
  1. ..S DR=".01///"_FNAM,DIE="^PXRMD(801.95,",DA=FHF
  1. ..D ^DIE
  1. ..;Reindex the cross-references.
  1. ..S DIK="^PXRMD(801.95,",DA=FHF
  1. ..D IX^DIK
  1. .;Edit
  1. .D EDIT^PXRMGEDT(PXRMGTYP,FHF,1)
  1. Q
  1. ;
  1. ;Ask ADD/MODIFY or not
  1. ;---------------------
  1. ZASK(YESNO,TEXT) ;
  1. N X,Y,DIR
  1. K DIROUT,DIRUT,DTOUT,DUOUT
  1. S DIR(0)="YA0"
  1. S DIR("A")=TEXT
  1. S DIR("B")="N"
  1. S DIR("?")="Enter Y or N. For detailed help type ??"
  1. S DIR("??")=U_"D ZHELP^PXRMSEL(2)"
  1. D ^DIR K DIR
  1. I $D(DIROUT) S DTOUT=1
  1. I $D(DTOUT)!($D(DUOUT)) Q
  1. S YESNO=$E(Y(0))
  1. Q
  1. ;
  1. ;General help text routine.
  1. ;--------------------------
  1. ZHELP(CALL) ;
  1. N HTEXT
  1. N DIWF,DIWL,DIWR,IC
  1. S DIWF="C75",DIWL=0,DIWR=75
  1. ;
  1. I CALL=1 D
  1. .S HTEXT(1)="Enter I to select an individual health factor. Enter A to"
  1. .S HTEXT(2)="process all health factor findings on a selected reminder."
  1. I CALL=2 D
  1. .S HTEXT(1)="Enter Yes to enter resolution status for this health"
  1. .S HTEXT(2)="factor. Enter No to continue to the next health factor."
  1. K ^UTILITY($J,"W")
  1. S IC=""
  1. F S IC=$O(HTEXT(IC)) Q:IC="" D
  1. . S X=HTEXT(IC)
  1. . D ^DIWP
  1. W !
  1. S IC=0
  1. F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
  1. . W !,^UTILITY($J,"W",0,IC,0)
  1. K ^UTILITY($J,"W")
  1. W !
  1. Q