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