Changeset 636 for FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMEUT1.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• CLINICAL_REMINDERS-PXRM/PXRMEUT1.m (modified) (6 diffs)

FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMEUT1.m

@@ -1 @@
-PXRMEUT1 ; SLC/PKR - General extract utilities ;05/08/2007
- ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
+PXRMEUT1 ; SLC/PKR - General extract utilities ;08/09/2006
+ ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
  ;=================================================
-CLDATES ;Cleanup entries in ^TMP("PXRMDDOC",$J) before making date checks.
- ;For drug findings consolidate PS(55, PS(55NVA, and PSRX( back to
- ;PSDRUG(.
- N FI,FIND0,ITEM,GLOBAL,LIST
- S FIND0=""
- F  S FIND0=$O(^TMP("PXRMDDOC",$J,FIND0)) Q:FIND0=""  D
- . S FI=$P(FIND0,U,1)
- . S GLOBAL=$P(FI,";",2)
- . I GLOBAL'["PS" Q
- . S GLOBAL="PSDRUG("
- . S ITEM=$P(FI,";",1)
- . S FI=ITEM_";"_GLOBAL_U_$P(FIND0,U,2,11)
- . S LIST(FIND0)=FI
- ;
- S FIND0=""
- F  S FIND0=$O(LIST(FIND0)) Q:FIND0=""  D
- . S FI=LIST(FIND0)
- . S ^TMP("PXRMDDOC",$J,FI)=^TMP("PXRMDDOC",$J,FIND0)
- . K ^TMP("PXRMDDOC",$J,FIND0)
- Q
+DCONV(DATE,LBBDT,LBEDT) ;Convert dates to actual values.
+ I DATE=0 Q DATE
+ N PXRMDATE
+ S PXRMDATE=$S(DATE["BDT":LBBDT,1:LBEDT)
+ S DATE=$$STRREP^PXRMUTIL(DATE,"BDT","T")
+ Q $$CTFMD^PXRMDATE(DATE)
  ;
  ;=================================================
@@ -36 +22 @@
  ;
  ;=================================================
-DCONV(DATE,LBBDT,LBEDT) ;Convert dates to actual values.
- I DATE=0 Q DATE
- N PXRMDATE
- S PXRMDATE=$S(DATE["BDT":LBBDT,1:LBEDT)
- S DATE=$$STRREP^PXRMUTIL(DATE,"BDT","T")
- Q $$CTFMD^PXRMDATE(DATE)
- ;
- ;=================================================
 DOCDATES(RULESET,LBBDT,LBEDT,NL,OUTPUT) ;
- N EM,FRACT,FRDATA,FRDATES,FRIEN,FRLST,FRLIEN,FROLST,FROUT,FRPAT
- N FRPERM,FRSTRT,FRTIEN,FRTYP,FSEQ,OPER,PXRMFVPL
+ N FINDPA,FRACT,FRDATA,FRDATES,FRIEN,FRLST,FRLIEN,FROLST,FROUT,FRPAT
+ N FRPERM,FRSTRT,FRTIEN,FRTYP,FSEQ,PXRMDATE,PXRMFVPL
  N RRIEN,RSDATA,RSDATES,RBDT,REDT,SEQ,SUB
- I $G(PXRMDDOC)=2 D CLDATES
  ;Build the variable pointer list.
  D BLDRLIST^PXRMVPTR(811.902,.01,.PXRMFVPL)
@@ -55 +32 @@
  . S SUB=$O(^PXRM(810.4,RULESET,30,"B",SEQ,"")) Q:'SUB
  . S RSDATA=$G(^PXRM(810.4,RULESET,30,SUB,0)) Q:RSDATA=""
- . S OPER=$P(RSDATA,U,3)
- . S OPER=$$EXTERNAL^DILFD(810.41,.03,"",OPER,.EM)
  . S RSDATES=$G(^PXRM(810.4,RULESET,30,SUB,1))
  .;Finding rule ien.
@@ -69 +44 @@
  .;Determine RBDT and REDT
  . D RDATES(RSDATES,FRDATES,LBBDT,LBEDT,.RBDT,.REDT)
+ . S PXRMDATE=LBEDT
+ . S $P(FINDPA(0),U,8)=RBDT,$P(FINDPA(0),U,11)=REDT
  . S NL=NL+1,OUTPUT(NL)=""
  . S NL=NL+1,OUTPUT(NL)="SEQUENCE "_SEQ_" "_$P(FRDATA,U,1)
- . S NL=NL+1,OUTPUT(NL)=" Operation: "_OPER
  .;Term finding rules
- . I FRTYP=1 D TERM(FRTIEN,LBBDT,LBEDT,RBDT,REDT,.PXRMFVPL,.NL,.OUTPUT)
+ . I FRTYP=1 D TERM(FRTIEN,.FINDPA,.PXRMFVPL,.NL,.OUTPUT)
  .;Reminder Definition List Rule
- . I FRTYP=2 D REM(RRIEN,LBBDT,LBEDT,RBDT,REDT,.PXRMFVPL,.NL,.OUTPUT)
+ . I FRTYP=2 D REM(RRIEN,.FINDPA,.PXRMFVPL,.NL,.OUTPUT)
  Q
  ;
  ;=================================================
-FMULPRT(FARR,PXRMFVPL,NL,OUTPUT) ;Print the finding multiple
+FMULPRT(DEFARR,FINDPA,PXRMFVPL,NL,OUTPUT) ;Print the finding multiple
  ;information.
- ;Q
- N BDT,EDT,DERROR,FNAME,FTYPE,IND,NOCC,TBDT,TEDT,TEMP,VPTR
+ N BDT,EDT,FNAME,FTYPE,IND,NOCC,PFINDPA,TFINDPA,VPTR
  S IND=0
- F  S IND=+$O(FARR(20,IND)) Q:IND=0  D
- . S VPTR=$P(FARR(20,IND,0),U,1)
+ F  S IND=+$O(DEFARR(20,IND)) Q:IND=0  D
+ . S VPTR=$P(DEFARR(20,IND,0),U,1)
  . S FNAME=$$ENTRYNAM^PXRMPTD2(VPTR)
  . S FTYPE=$$FTYPE^PXRMPTD2(VPTR,1)
  . S NL=NL+1,OUTPUT(NL)="  FINDING "_IND_"-"_FTYPE_"."_FNAME
+ . K PFINDPA,TFINDPA
+ . M TFINDPA=DEFARR(20,IND)
  .;Set the finding parameters.
- . D SSPAR^PXRMUTIL(FARR(20,IND,0),.NOCC,.BDT,.EDT)
+ . D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
+ . D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
  . S NL=NL+1,OUTPUT(NL)="   Beginning Date/Time: "_$$FMTE^XLFDT(BDT,"5Z")
  . S NL=NL+1,OUTPUT(NL)="   Ending Date/Time:    "_$$FMTE^XLFDT(EDT,"5Z")
- . I $G(PXRMDDOC)'=2 Q
- . S DERROR=0
- . S TEMP=$G(^TMP("PXRMDDOC",$J,$P(FARR(20,IND,0),U,1,11)))
- .;If TEMP is null then no evaluation was required and the check 
- .;cannot be made
- . I TEMP="" Q
- . I $P(TEMP,U,1)'=BDT D
- .. S DERROR=1
- .. S NL=NL+1,OUTPUT(NL)="  There is a consistency problem with the beginning date!"
- .. S NL=NL+1,OUTPUT(NL)="  Date used to build the list was: "_$$FMTE^XLFDT($P(TEMP,U,1),"5Z")
- . I $P(TEMP,U,2)'=EDT D
- .. S DERROR=1
- .. S NL=NL+1,OUTPUT(NL)="  There is a consistency problem with the ending date!"
- .. S NL=NL+1,OUTPUT(NL)="  Date used to build the list was: "_$$FMTE^XLFDT($P(TEMP,U,2),"5Z")
- . I DERROR D
- .. S NL=NL+1,OUTPUT(NL)="  Please notify the developers."
- .. ;S NL=NL+1,OUTPUT(NL)="  Please enter a Remedy ticket."
- .. S NL=NL+1,OUTPUT(NL)=" "
  Q
  ;
@@ -122 +82 @@
  I RBDT="" S RBDT=0
  I REDT="" S REDT=LBEDT
- I REDT=0 S REDT=DT
+ I REDT=0 S REDT=$$DT^XLFDT
  ;Convert RBDT and REDT to FileMan dates.
  S RBDT=$$DCONV(RBDT,LBBDT,LBEDT)
@@ -137 +97 @@
  ;
  ;=================================================
-REM(IEN,LBBDT,LBEDT,RBDT,REDT,PXRMFVPL,NL,OUTPUT) ;
+REM(IEN,FINDPA,PXRMFVPL,NL,OUTPUT) ;
  N DEFARR
  D DEF^PXRMLDR(IEN,.DEFARR)
- D DATES^PXRMRUL1(LBBDT,LBEDT,RBDT,REDT,.DEFARR)
  S NL=NL+1,OUTPUT(NL)=" REMINDER DEFINITION "_$P(DEFARR(0),U,1)
- D FMULPRT(.DEFARR,.PXRMFVPL,.NL,.OUTPUT)
+ D FMULPRT(.DEFARR,.FINDPA,.PXRMFVPL,.NL,.OUTPUT)
  Q
  ;
  ;=================================================
-TERM(IEN,LBBDT,LBEDT,RBDT,REDT,PXRMFVPL,NL,OUTPUT) ;
+TERM(IEN,FINDPA,PXRMFVPL,NL,OUTPUT) ;
  N TERMARR
  D TERM^PXRMLDR(IEN,.TERMARR)
- D DATES^PXRMRUL1(LBBDT,LBEDT,RBDT,REDT,.TERMARR)
  S NL=NL+1,OUTPUT(NL)=" TERM "_$P(TERMARR(0),U,1)
- D FMULPRT(.TERMARR,.PXRMFVPL,.NL,.OUTPUT)
+ D FMULPRT(.TERMARR,.FINDPA,.PXRMFVPL,.NL,.OUTPUT)
  Q
  ;