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

GMRAFA.m

Go to the documentation of this file.
  1. GMRAFA ;ISP/RFR - CORRECT ASSESSMENTS ;06/21/2016 15:04
  1. ;;4.0;Adverse Reaction Tracking;**48,53,61**;Mar 29, 1996;Build 3
  1. EN ; -- main entry point for GMRA ASSESS FIX
  1. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. I '$D(^XTMP("GMRAFAL")) D Q
  1. .W !!,"I will create a task to build the list of assessments that need review"
  1. .W !,"and send you an email when the list is built.",!
  1. .N XMDUZ,XMDF,XMY,X,XMOUT
  1. .S XMDUZ=.5,^XTMP("GMRAFAL","B","RECIPS",DUZ)=""
  1. .S DIR(0)="Y"_U_"A",DIR("A")="Shall I notify anyone else when the list is built"
  1. .S DIR("B")="NO",DIR("?")="Enter YES to add other recipients or NO to not add other recipients."
  1. .D ^DIR
  1. .I $D(DIRUT) K ^XTMP("GMRAFAL") Q ; p61 kill global if exiting before job is created
  1. .I +Y S XMDF=1 D DES^XMA21 I X="",'$D(XMOUT),$D(XMY) M ^XTMP("GMRAFAL","B","RECIPS")=XMY
  1. .K X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. .S DIR(0)="Y"_U_"A",DIR("A")="Do you want to include deceased patients in the list"
  1. .S DIR("B")="NO",DIR("?",1)="Enter YES to include deceased patients in the list or NO to exclude deceased"
  1. .S DIR("?")="patients from the list."
  1. .D ^DIR
  1. .I $D(DIRUT) K ^XTMP("GMRAFAL") Q ; p61 kill global if exiting before job is created
  1. .S ^XTMP("GMRAFAL","Q","INC_DEAD")=+Y
  1. .N ZTRTN,ZTDESC,ZTIO,ZTSK
  1. .S ZTRTN="LISTBLD^GMRAFA",ZTDESC="GMRA ASSESSMENT LIST BUILDER",ZTIO=""
  1. .W !!,"Enter the date and time below when the assessment list builder should start.",!
  1. .D ^%ZTLOAD
  1. .I $D(ZTSK) S ^XTMP("GMRAFAL","B")=ZTSK W !!,"Successfully queued the assessment list builder; task #"_ZTSK_".",!!
  1. .E W !!,"The assessment list builder was not scheduled.",!! K ^XTMP("GMRAFAL") Q ; p61 kill global if exiting before job is created
  1. .S:$D(^XTMP("GMRAFAL")) ^XTMP("GMRAFAL",0)=$$FMADD^XLFDT(DT,30,0,0,0)_U_DT_U_"GMRA ASSESSMENT LIST"
  1. I $G(^XTMP("GMRAFAL","B"))>0 D Q
  1. .N ZTSK S ZTSK=+$G(^XTMP("GMRAFAL","B"))
  1. .W !!,"Task #"_ZTSK
  1. .D ISQED^%ZTLOAD
  1. .I ZTSK(0)=1 W " is scheduled to build the list" I $G(ZTSK("D"))>0 W " on "_$$HTE^XLFDT(ZTSK("D")) K ZTSK
  1. .I $D(ZTSK(0)),ZTSK(0)="" D
  1. ..W " could not be found.",!
  1. ..I DUZ(0)'["@" W "Please contact IRM for assistance" I $G(ZTSK("E"))'="" W " with error code "_$G(ZTSK("E"))
  1. ..E D RESET
  1. .I $D(ZTSK(0)),ZTSK(0)=0 D
  1. ..K ZTSK S ZTSK=+$G(^XTMP("GMRAFAL","B"))
  1. ..D STAT^%ZTLOAD
  1. ..I ZTSK(1)=2 K ZTSK W " is currently building the list" I $G(^XTMP("GMRAFAL","B","STATUS"))'="" W " and is "_^("STATUS")
  1. ..I $D(ZTSK(1)),ZTSK(1)=5 D
  1. ...W " stopped abnormally.",!
  1. ...I DUZ(0)'["@" W "Please contact IRM for assistance"
  1. ...E D RESET
  1. ..I $D(ZTSK(1)),ZTSK(1)'=2,ZTSK(1)'=5 D
  1. ...W " has a problem.",!
  1. ...I DUZ(0)'["@" W "Please contact IRM for assistance"
  1. ...E D RESET
  1. .W "."
  1. .Q:$D(ZTSK)
  1. .I $D(^XTMP("GMRAFAL","B","RECIPS",DUZ)) W !,"I will notify you when the list is complete.",!! Q
  1. .S DIR(0)="Y"_U_"A",DIR("A")="Shall I send you an email when the list is built"
  1. .S DIR("?")="Enter YES to add yourself to the recipient list or NO to not add yourself."
  1. .D ^DIR
  1. .I +Y D
  1. ..S ^XTMP("GMRAFAL","B","RECIPS",DUZ)="" W !,"I will notify you when the list is complete.",!
  1. ..S ^XTMP("GMRAFAL",0)=$$FMADD^XLFDT(DT,30,0,0,0)_U_DT_U_"GMRA ASSESSMENT LIST"
  1. D EN^VALM("GMRA ASSESS FIX")
  1. I $O(^XTMP("GMRAFAL",0))="B" K ^XTMP("GMRAFAL") Q
  1. K ^TMP($J,"GMRAFAL")
  1. Q
  1. ;
  1. RESET ; -- reset the option
  1. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. S DIR(0)="Y"_U_"A",DIR("A")="Shall I reset this option"
  1. S DIR("?")="Enter YES to delete the task number or NO to do nothing."
  1. D ^DIR
  1. I +Y K ^XTMP("GMRAFAL")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. S VALMHDR(1)="Adverse Reaction Tracking Assessment Corrector"
  1. Q
  1. ;
  1. LISTBLD ; -- search for problem patients
  1. N DFN,TEXT,TOTAL,CUR,X,VALMCNT,INCDEAD,EXIT
  1. S ^XTMP("GMRAFAL",0)=$$FMADD^XLFDT(DT,30,0,0,0)_U_DT_U_"GMRA ASSESSMENT LIST"
  1. S VALMCNT=0,TOTAL=$O(^DPT("?"),-1),INCDEAD=+$G(^XTMP("GMRAFAL","Q","INC_DEAD"))
  1. S DFN=0 F S DFN=$O(^DPT(DFN)) Q:'DFN D
  1. .I 'INCDEAD D I $G(EXIT) S EXIT=0 Q
  1. ..N VADM
  1. ..D DEM^VADPT
  1. ..I $G(VADM(6))'="" S EXIT=1
  1. .N COUNT,ASSESS
  1. .I '(DFN#1000) D
  1. ..S CUR=(DFN/TOTAL)*100,CUR=+$P(CUR,".")_"."_$E(+$P(CUR,".",2),1,2)
  1. ..S ^XTMP("GMRAFAL","B","STATUS")=CUR_"% complete"
  1. .I $D(^DPT(DFN,-9)) Q
  1. .Q:$$VERIFY(DFN,.COUNT,.ASSESS)
  1. .S VALMCNT=VALMCNT+1
  1. .S ^XTMP("GMRAFAL",VALMCNT,DFN,"PATIENT")=$$GET1^DIQ(2,DFN_",",.01)
  1. .S ^XTMP("GMRAFAL",VALMCNT,DFN,"ASSESSMENT")=$$EASSESS($G(ASSESS("EXTERNAL")))
  1. .S ^XTMP("GMRAFAL",VALMCNT,DFN,"ALLERGIES")=+$G(COUNT("GOOD"))
  1. N XMDUZ,XMSUB,XMZ,XMY
  1. S XMDUZ=.5,XMSUB="GMRA ASSESSMENT FIX LIST BUILD STATUS"
  1. M XMY=^XTMP("GMRAFAL","B","RECIPS")
  1. D XMZ^XMA2
  1. I XMZ>0 D
  1. .;ICR #10113 MAILMAN: Message Text - Direct Entry
  1. .I VALMCNT=0 D
  1. ..K ^XTMP("GMRAFAL")
  1. ..S ^XMB(3.9,XMZ,2,0)=U_3.92_U_2_U_2_U_DT
  1. ..S ^XMB(3.9,XMZ,2,1,0)="The assessment list builder has determined there are no patients with"
  1. ..S ^XMB(3.9,XMZ,2,2,0)="assessment problems. No further action is needed."
  1. .I VALMCNT>0 D
  1. ..K ^XTMP("GMRAFAL","B")
  1. ..S ^XTMP("GMRAFAL","B")=0
  1. ..S ^XMB(3.9,XMZ,2,0)=U_3.92_U_6_U_6_U_DT
  1. ..S ^XMB(3.9,XMZ,2,1,0)="The assessment list builder has successfully created the list of patients to"
  1. ..S ^XMB(3.9,XMZ,2,2,0)="review."
  1. ..S ^XMB(3.9,XMZ,2,3,0)=" "
  1. ..S ^XMB(3.9,XMZ,2,4,0)="Please use option Assessment clean up utility [GMRA ASSESSMENT UTILITY],"
  1. ..S ^XMB(3.9,XMZ,2,5,0)="located on the Enter/Edit Site Configurable Files [GMRA SITE FILE MENU] menu,"
  1. ..S ^XMB(3.9,XMZ,2,6,0)="to process this list."
  1. .D ENT2^XMD
  1. S ZTREQ="@"
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. W @IOF,"Please wait while I prepare the list."
  1. N DFN,TEXT,TOTAL,CUR,TEXT,LAST
  1. K ^TMP($J,"GMRAFAL")
  1. S CUR=0 F S CUR=$O(^XTMP("GMRAFAL",CUR)) Q:'+CUR D
  1. .S LAST=1+$G(LAST),^TMP($J,"GMRAFAL","C",LAST,CUR)=""
  1. S CUR=0 F S CUR=$O(^TMP($J,"GMRAFAL","C",CUR)) Q:'+CUR S LAST=$O(^TMP($J,"GMRAFAL","C",CUR,0)),DFN=$O(^XTMP("GMRAFAL",LAST,0)) D
  1. .S TEXT="",TEXT=$$SETFLD^VALM1(CUR_".",TEXT,"LINENO")
  1. .S TEXT=$$SETFLD^VALM1($G(^XTMP("GMRAFAL",LAST,DFN,"PATIENT")),TEXT,"PATIENT")
  1. .S TEXT=$$SETFLD^VALM1($$CJ^XLFSTR($G(^XTMP("GMRAFAL",LAST,DFN,"ASSESSMENT")),$P(VALMDDF("ASSESSMENT"),U,3)),TEXT,"ASSESSMENT")
  1. .S TEXT=$$SETFLD^VALM1($$CJ^XLFSTR($G(^XTMP("GMRAFAL",LAST,DFN,"ALLERGIES")),$P(VALMDDF("ALLERGIES"),U,3)),TEXT,"ALLERGIES")
  1. .D SET^VALM10(CUR,TEXT,DFN)
  1. .S VALMCNT=CUR
  1. S:$G(VALMCNT)="" VALMCNT=0,VALMSG="No problems found"
  1. Q
  1. ;
  1. VERIFY(DFN,COUNT,ASSESS) ; -- verify the assessment matches the allergies
  1. N IEN,RETURN
  1. K COUNT,ASSESS
  1. S (IEN,COUNT,RETURN)=0
  1. F S IEN=$O(^GMR(120.8,"B",DFN,IEN)) Q:'IEN D
  1. .I +$P($G(^GMR(120.8,IEN,"ER")),U) S COUNT("ERROR")=1+$G(COUNT("ERROR"))
  1. .I '+$P($G(^GMR(120.8,IEN,"ER")),U) S COUNT("GOOD")=1+$G(COUNT("GOOD"))
  1. S ASSESS=+$O(^GMR(120.86,"B",DFN,0))
  1. S:ASSESS>0 ASSESS("EXTERNAL")=$$GET1^DIQ(120.86,ASSESS_",",1),ASSESS=$P($G(^GMR(120.86,ASSESS,0)),U,2)
  1. I +ASSESS,(+$G(COUNT("GOOD"))>0) S RETURN=1
  1. I '+ASSESS,('+$G(COUNT("GOOD"))) S RETURN=1
  1. Q RETURN
  1. ;
  1. EASSESS(ASSESS) ; -- return the external value of the assessment
  1. Q $S($G(ASSESS)="":"No Assess.",1:$G(ASSESS))
  1. ;
  1. HELP ; -- help code
  1. D FULL^VALM1
  1. W !!,"Use SP to select the patient you want to work with. You can only work with one",!
  1. W "patient at a time.",!
  1. D WAIT^GMRAFX3
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. D FULL^VALM1
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. Q
  1. ;
  1. PATIENT ; -- select patient
  1. N GMRAITM,DFN,ASSESS,COUNT,EXIT,ISFIXED,GMRAACT
  1. D SELECT^GMRAFA1(.GMRAITM,"patients")
  1. I 'GMRAITM S VALMSG="No problems found" Q
  1. Q:GMRAITM<0
  1. S DFN=+$O(@VALMAR@("IDX",GMRAITM,"")),EXIT=0
  1. I $D(^XTMP("GMRAFA",DFN)),('$D(^XTMP("GMRAFA",DFN,DUZ))) D Q
  1. .N IEN
  1. .S IEN=+$O(^XTMP("GMRAFA",DFN,0))
  1. .W !,$S(IEN>0:$$GET1^DIQ(200,IEN_",",.01),1:"Someone")_" has locked that patient's records"
  1. .I $G(^XTMP("GMRAFA",DFN,IEN))'="" W !,"in process ID number "_$G(^XTMP("GMRAFA",DFN,IEN))
  1. .W "."
  1. .D WAIT^GMRAFX3
  1. I $D(^XTMP("GMRAFA",DFN,DUZ)),($G(^XTMP("GMRAFA",DFN,DUZ))'=$J) D Q:$G(EXIT)
  1. .N IEN
  1. .S IEN=+$O(^XTMP("GMRAFA",DFN,0))
  1. .W !,"You are already editing this patient in a different session",!
  1. .W "(that session has process ID number "_$G(^XTMP("GMRAFA",DFN,IEN))_").",!
  1. .N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. .S DIR(0)="YA"_U,DIR("A",1)="Are you sure you want to continue editing"
  1. .S DIR("A")="this patient in this session? ",DIR("B")="NO"
  1. .D ^DIR
  1. .I $D(DIRUT)!('Y) S EXIT=1
  1. S GMRAACT=+$O(^TMP($J,"GMRAFAL","C",GMRAITM,0))
  1. I $$VERIFY(DFN,.COUNT,.ASSESS) D Q
  1. .W !,"Number "_GMRAITM_" has already been corrected."
  1. .D FLDTEXT^VALM10(GMRAITM,"ASSESSMENT",$$CJ^XLFSTR($$EASSESS($G(ASSESS("EXTERNAL"))),$P(VALMDDF("ASSESSMENT"),U,3)))
  1. .D FLDTEXT^VALM10(GMRAITM,"ALLERGIES",$$CJ^XLFSTR(+$G(COUNT("GOOD")),$P(VALMDDF("ALLERGIES"),U,3)))
  1. .D FLDTEXT^VALM10(GMRAITM,"STATUS","**FIXED**")
  1. .I GMRAACT>0,$D(^XTMP("GMRAFAL",GMRAACT)) K ^XTMP("GMRAFAL",GMRAACT)
  1. .D WAIT^GMRAFX3
  1. S ^XTMP("GMRAFA",0)=$$FMADD^XLFDT(DT,7,0,0,0)_U_DT_U_"GMRA ASSESSMENT FIX LOCKS",^XTMP("GMRAFA",DFN,DUZ)=$J
  1. D EN^VALM("GMRA ASSESS FIX DETAIL")
  1. S ISFIXED=$$VERIFY(DFN,.COUNT,.ASSESS)
  1. D FLDTEXT^VALM10(GMRAITM,"ASSESSMENT",$$CJ^XLFSTR($$EASSESS($G(ASSESS("EXTERNAL"))),$P(VALMDDF("ASSESSMENT"),U,3)))
  1. D FLDTEXT^VALM10(GMRAITM,"ALLERGIES",$$CJ^XLFSTR(+$G(COUNT("GOOD")),$P(VALMDDF("ALLERGIES"),U,3)))
  1. I GMRAACT>0,'ISFIXED D
  1. .S ^XTMP("GMRAFAL",GMRAACT,DFN,"ASSESSMENT")=$$EASSESS($G(ASSESS("EXTERNAL")))
  1. .S ^XTMP("GMRAFAL",GMRAACT,DFN,"ALLERGIES")=+$G(COUNT("GOOD"))
  1. I ISFIXED D
  1. .D FLDTEXT^VALM10(GMRAITM,"STATUS","**FIXED**")
  1. .K:GMRAACT>0 ^XTMP("GMRAFAL",GMRAACT)
  1. D WRITE^VALM10(GMRAITM)
  1. D RE^VALM4
  1. I $D(^XTMP("GMRAFA",DFN,DUZ)),($G(^XTMP("GMRAFA",DFN,DUZ))=$J) K ^XTMP("GMRAFA",DFN)
  1. Q
  1. ;