- 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 Jan 18, 2025@02:40:18 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 ;