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

PXRMSEL2.m

Go to the documentation of this file. 
  1. PXRMSEL2 ; SLC/PJH - PXRM Selection ;04/16/2000
  1.  ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
  1.  ;
  1.  ; Called from PXRMSEL
  1.  ;
  1.  ;Select Health factors requiring resolutions
  1.  ;-------------------------------------------
  1. START W IORESET
  1.  ;Select to edit individual or reminder's Health Factors
  1.  D OPT(.ANS) Q:$D(DTOUT)!$D(DUOUT)  Q:ANS="I"
  1.  ;Select Reminder
  1.  S DIC("A")="SELECT REMINDER: "
  1.  S LIT1="You must select a reminder!"
  1.  D REM(.ARRAY) Q:$D(DTOUT)!$D(DUOUT)
  1.  ;Scan health factors
  1.  D SKIP
  1.  ;Rebuild listman screen
  1.  D INIT^PXRMSEL
  1.  Q
  1.  ;
  1.  ;Ask ADD/MODIFY or not
  1.  ;---------------------
  1. ASK(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.  ;Select single HF or all HF's for the reminder
  1.  ;---------------------------------------------
  1. OPT(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. REM(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.  ;Dialog type selection
  1.  ;---------------------
  1. SEL(TYPE) ;
  1.  W IORESET
  1.  N X,Y,DIR
  1.  K DIROUT,DIRUT,DTOUT,DUOUT
  1.  S DIR(0)="S"_U_"D:Reminder Dialogs;"
  1.  S DIR(0)=DIR(0)_"E:Dialog Elements;"
  1.  S DIR(0)=DIR(0)_"F:Forced Values;"
  1.  S DIR(0)=DIR(0)_"G:Dialog Groups;"
  1.  S DIR(0)=DIR(0)_"P:Additional Prompts;"
  1.  S DIR(0)=DIR(0)_"R:Reminders;"
  1.  S DIR(0)=DIR(0)_"RG:Result Group (Mental Health);"
  1.  S DIR(0)=DIR(0)_"RE:Result Element (Mental Health);"
  1.  S DIR("A")="TYPE OF VIEW"
  1.  S DIR("B")="R"
  1.  S DIR("?")="Select from the codes displayed. For detailed help type ??"
  1.  S DIR("??")=U_"D HELP^PXRMSEL2(3)"
  1.  D ^DIR K DIR
  1.  I $D(DIROUT) S DTOUT=1
  1.  I $D(DTOUT)!($D(DUOUT)) Q
  1.  S TYPE=Y
  1.  ;Change display type
  1.  S PXRMGTYP=$S(TYPE="D":"DLG",TYPE="R":"DLGR",1:"DLGE")
  1.  I TYPE'="R" D
  1.  .I TYPE="D" S PXRMDTYP="R" Q
  1.  .I TYPE="RG" S PXRMDTYP="S" Q
  1.  .I TYPE="RE" S PXRMDTYP="T" Q
  1.  .S PXRMDTYP=TYPE
  1.  Q
  1.  ;
  1.  ;Reminders Health Factors
  1.  ;------------------------
  1. SKIP 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 ASK(.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.  ;General help text routine.
  1.  ;--------------------------
  1. HELP(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.  I CALL=3 D
  1.  .S HTEXT(1)="Select the type of view to be displayed. You may view"
  1.  .S HTEXT(2)="either reminders or selected dialog types."
  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