Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMLDEM9.m

    r613 r623  
    1 IVMLDEM9        ;ALB/BRM/PHH - IVM ADDRESS UPDATES PENDING REVIEW RPT ; 04/09/08 13:35pm
    2         ;;2.0;INCOME VERIFICATION MATCH;**79,93,119,126**; 21-OCT-94;Build 1
    3         ;;Per VHA Directive 10-93-142, this routine should not be modified.
    4         ;
    5         Q
    6         ;
    7 EN2     ;entry point for IVM ADDR UPDT PENDING REVIEW menu option
    8         K ^TMP("IVMLDEM9",$J)
    9         K ^TMP($J,"IVMLDEM9")
    10         ;If mail group has no member or remote-member
    11         I '$$MEMBER() D  Q
    12         . I '$D(ZTQUEUED) W !!,"IVM ADDR UPDT REPORT does not have a member. Report not sent." K DIR S DIR(0)="E" D ^DIR K DIR
    13         I +$G(ZTSK) D PRINT,EXIT Q  ;started by Taskman job
    14         ;User runs the option
    15         I '$D(ZTQUEUED) D
    16         . W !!,"The report will be sent to mail group IVM ADDR UPDT REPORT"
    17         . D QUE
    18         . D EXIT
    19         . K DIR S DIR(0)="E" D ^DIR K DIR
    20         Q
    21         ;
    22 LOOP(DTPARAM,FILDAT)    ;main loop
    23         N DFN,IVMDT,IVMDA,IVMDA1,IVMDA2,RF171,TODAY,AUTODT,DTDIFF,NAME,UPLDT
    24         N X1,X2,Y,SSN,DFN
    25         D DT^DILF("X","T"_$G(DTPARAM),.AUTODT)
    26         S TODAY=$$DT^XLFDT S:'$G(FILDAT) FILDAT=0
    27         Q:'$G(AUTODT)  ;this should never occur, but just in case
    28         S RF171=$O(^IVM(301.92,"C","RF171","")),IVMDA2=""
    29         Q:'RF171
    30         F  S IVMDA2=$O(^IVM(301.5,IVMDA2)) Q:IVMDA2=""  D
    31         .S DFN=$P($G(^IVM(301.5,IVMDA2,0)),"^"),IVMDA1=""
    32         .Q:('DFN)!('$D(^DPT(+DFN)))!('$D(^IVM(301.5,IVMDA2,"IN")))
    33         .F  S IVMDA1=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1)) Q:IVMDA1=""  D
    34         ..Q:'$D(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",RF171))
    35         ..S IVMDA=""
    36         ..F  S IVMDA=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",RF171,IVMDA)) Q:'IVMDA  D
    37         ...S IVMDT=$P($G(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMDA,0)),"^",3)
    38         ...Q:('IVMDT)!(IVMDT>AUTODT)
    39         ...; report addresses that will be auto-uploaded in DTDIFF days
    40         ...S X1=TODAY,X2=IVMDT D ^%DTC S DTDIFF=+$G(X)
    41         ...S NAME=$P($G(^DPT(DFN,0)),"^"),SSN=$P($G(^DPT(DFN,0)),"^",9)
    42         ...S X1=IVMDT,X2=14 D C^%DTC S UPLDT=$G(X)
    43         ...I '$D(^IVM(301.5,"ASEG","PID",IVMDA2)) Q
    44         ...S ^TMP("IVMLDEM9",$J,DTDIFF,SSN,IVMDA)=$G(NAME)_"^"_$P(IVMDT,".")_"^"_$P(UPLDT,".")_"^"_DFN_"^"_IVMDA2_"^"_IVMDA1
    45         Q
    46         ;
    47 AUTOLOAD(DFN,IVMDA2,IVMDA1)     ;auto-upload records that not been reviewed
    48         ; this tag is called from ^IVMLDEMC
    49         ;
    50         Q:('$G(DFN))!('$G(IVMDA2))!('$G(IVMDA1))
    51         N IVMI,IVMJ,IVMFIELD,IVMVALUE,IVMNODE,IVMFLAG,DUZ
    52         S DUZ="IVM AUTO ADDR JOB"
    53         ;
    54         ; determine appropriate address change dt/tm to be used
    55         D ADDRDT^IVMLDEM6(DFN,IVMDA2,IVMDA1)
    56         ;
    57         N DGPRIOR D GETPRIOR^DGADDUTL(DFN,.DGPRIOR)
    58         ;
    59         ; loop through the record to be uploaded
    60         S IVMI=0 F  S IVMI=$O(^IVM(301.92,"AD",IVMI)) Q:IVMI']""  D
    61         .S IVMJ=0 F  S IVMJ=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IVMI,IVMJ)) Q:IVMJ']""  D
    62         ..;
    63         ..; check for data node in (#301.511) sub-file
    64         ..S IVMNODE=$G(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMJ,0))
    65         ..Q:('+IVMNODE)!($P(IVMNODE,"^",2)']"")
    66         ..;
    67         ..; check for residence phone number -> do not auto-upload
    68         ..Q:(+IVMNODE=$O(^IVM(301.92,"B","PHONE NUMBER [RESIDENCE]",0)))
    69         ..;
    70         ..; do not auto-upload if there is an active prescription
    71         ..I $$PHARM^IVMLDEM6(+DFN) D REJTADD Q
    72         ..;
    73         ..; set upload parameters
    74         ..S IVMFIELD=$P($G(^IVM(301.92,+IVMNODE,0)),"^",5)
    75         ..S IVMVALUE=$P(IVMNODE,"^",2)
    76         ..;
    77         ..; load addr field into the Patient (#2) file
    78         ..D UPLOAD^IVMLDEM6(DFN,IVMFIELD,IVMVALUE) S IVMFLAG=1
    79         ..;
    80         ..; remove entry from (#301.511) sub-file
    81         ..D DELENT^IVMLDEMU(IVMDA2,IVMDA1,IVMJ)
    82         ..;
    83         ..; if no display or uploadable fields, delete PID segment
    84         ..I ('$$DEMO^IVMLDEM5(IVMDA2,IVMDA1,0))&('$$DEMO^IVMLDEM5(IVMDA2,IVMDA1,1)) D DELETE^IVMLDEM5(IVMDA2,IVMDA1," ")
    85         ;
    86         I +$G(IVMFLAG) D
    87         .N DGCURR
    88         .D GETUPDTS^DGADDUTL(DFN,.DGCURR)
    89         .D UPDADDLG^DGADDUTL(DFN,.DGPRIOR,.DGCURR)
    90         Q
    91 REJTADD ;Reject the address
    92         ; update the ADDRESS CHANGE DT/TM field #.118 in PATIENT file #2
    93         D UPDDTTM^DGADDUTL(DFN,"PERM")
    94         ;
    95         ; trigger the record to transmit the existing address on file to HEC
    96         N DGENUPLD   ; Used in SETSTAT^IVMPLOG to prevent filing.
    97         N DA,X,IVMX
    98         S (DA,X)=DFN
    99         S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX
    100         Q
    101 PRINT   ;report output
    102         N DAYS,SSN,DATA,EX,PAGE,IVMDA,DATA,IVMLN,XMY,XMSUB,XMDUZ,XMTEXT
    103         D LOOP("",0)
    104         D HDR
    105         D DISPLAY
    106         D EMAIL
    107         Q
    108 DISPLAY ;Display the report
    109         S DAYS=""
    110         I '$D(^TMP("IVMLDEM9",$J)) Q
    111         F  S DAYS=$O(^TMP("IVMLDEM9",$J,DAYS),-1) Q:DAYS=""!($G(EX))  D
    112         .S SSN=""
    113         .F  S SSN=$O(^TMP("IVMLDEM9",$J,DAYS,SSN)) Q:SSN=""!($G(EX))  D
    114         ..S IVMDA=""
    115         ..F  S IVMDA=$O(^TMP("IVMLDEM9",$J,DAYS,SSN,IVMDA)) Q:(IVMDA="")!($G(EX))  D
    116         ...S DATA=$G(^TMP("IVMLDEM9",$J,DAYS,SSN,IVMDA))
    117         ... D LNPLUS
    118         ... S ^TMP($J,"IVMLDEM9",IVMLN)="       "_$$FMTE^XLFDT($P(DATA,"^",3))_"      "_$$FMTE^XLFDT($P(DATA,"^",2))_"      "_SSN_"     "_$P(DATA,"^")
    119         ... S ^TMP($J,"IVMLDEM9","TOTAL")=$G(^TMP($J,"IVMLDEM9","TOTAL"))+1
    120         D TOTAL
    121         D
    122         . D LNPLUS
    123         . S ^TMP($J,"IVMLDEM9",IVMLN)=""
    124         . D LNPLUS
    125         . S ^TMP($J,"IVMLDEM9",IVMLN)="                    <<END OF REPORT>>"
    126         I $E(IOST)="C" W ! K DIR S DIR(0)="E" D ^DIR K DIR
    127         Q
    128 HDR     ;print header
    129         N IVMDT,Y,DLINE
    130         I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,EX)=1 Q
    131         S Y=DT X ^DD("DD") S IVMDT=Y
    132         D
    133         . D LNPLUS
    134         . S ^TMP($J,"IVMLDEM9",IVMLN)=""
    135         . D LNPLUS
    136         . S ^TMP($J,"IVMLDEM9",IVMLN)=" IVM ADDRESS UPDATES PENDING REVIEW          "_IVMDT
    137         . D LNPLUS
    138         . S $P(^TMP($J,"IVMLDEM9",IVMLN),"=",78)=""
    139         . D LNPLUS
    140         . S ^TMP($J,"IVMLDEM9",IVMLN)=""
    141         . D LNPLUS
    142         . S ^TMP($J,"IVMLDEM9",IVMLN)="     Auto-Upload Date    Date Received        SSN        Patient Name"
    143         . D LNPLUS
    144         . S ^TMP($J,"IVMLDEM9",IVMLN)="     ----------------    -------------     ---------     ------------"
    145         Q
    146 EXIT    D ^%ZISC,HOME^%ZIS Q
    147         K ^TMP($J,"IVMLDEM9")
    148         K ^TMP("IVMLDEM9",$J)
    149         ;
    150 ADRDTCK(DFN,IVMDA2,IVMDA1)      ;is the incoming address older than #2 address?
    151         Q:'$G(DFN)!('$G(IVMDA2))!('$G(IVMDA1)) "0^MISSING INPUT PARAMETER"
    152         N OADDRDT,NADDRDT,ERR,IVMDA,IEN92,IENS
    153         S OADDRDT=$$GET1^DIQ(2,DFN_",",.118,"I","","ERR") Q:$D(ERR) "0^OLD ADDR ERROR"
    154         S IEN92=$O(^IVM(301.92,"C","RF171","")) Q:'IEN92 "0^BAD #301.92 ENTRY FOR RF171"
    155         I '$D(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IEN92)) Q "0^ADDR DT NOT PRESENT"
    156         S IVMDA=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IEN92,"")) Q:'IVMDA "0^MISSING ADDR DT IN 301.5"
    157         S IENS=IVMDA_","_IVMDA1_","_IVMDA2_","
    158         S NADDRDT=$$GET1^DIQ(301.511,IENS,.02,"I","","ERR") Q:$D(ERR) "0^NEW ADDR ERROR"
    159         Q:(OADDRDT="")&(NADDRDT="") 0
    160         Q:(NADDRDT="")!(OADDRDT'<NADDRDT) 1
    161         Q "0^INCOMING ADDRESS IS NEWER THAN PATIENT FILE ADDR"
    162 MEMBER()        ;Return 0 if mail group has no local or remote member
    163         N RESULT,IVMIEN,IVMRMT
    164         S RESULT=1
    165         S IVMIEN=$$FIND1^DIC(3.8,"","X","IVM ADDR UPDT REPORT")
    166         D LIST^DIC(3.812,","_IVMIEN_",",.01,"P","","","","","","","IVMRMT")
    167         I ($P($G(IVMRMT("DILIST",0)),U)'>0),('$$GOTLOCAL^XMXAPIG("IVM ADDR UPDT REPORT")) S RESULT=0
    168         Q RESULT
    169 EMAIL   ;Set up parameters to email the report
    170         ;If called within a task, protect variables
    171         I $D(ZTQUEUED) N %,DIFROM
    172         N RDT
    173         D NOW^%DTC S Y=% X ^DD("DD")
    174         S RDT=$P(Y,"@",1)_"@"_$P($P(Y,"@",2),":",1,2)
    175         S XMSUB="IVM Address Pending Review ("_RDT_")"
    176         S XMY("G.IVM ADDR UPDT REPORT")=""
    177         I $G(^TMP($J,"IVMLDEM9","TOTAL"))<1 D
    178         . D LNPLUS
    179         . S ^TMP($J,"IVMLDEM9",IVMLN)=""
    180         . D LNPLUS
    181         . S ^TMP($J,"IVMLDEM9",IVMLN)="*** NO RECORDS TO PRINT ***"
    182         S XMTEXT="^TMP($J,""IVMLDEM9"","
    183         D ^XMD
    184         Q
    185 QUE     ;Que the task if user invokes option
    186         N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZUSR,POP,X,ERR,IOP
    187         W !
    188         S ZTIO=""
    189         S ZTRTN="PRINT^IVMLDEM9"
    190         S ZTDESC="IVM AUTO ADDRESS UPLOAD RPT"
    191         D ^%ZTLOAD
    192         D ^%ZISC,HOME^%ZIS
    193         W !,$S($D(ZTSK):"REQUEST QUEUED AS TASK#"_ZTSK,1:"REQUEST CANCELLED!")
    194         Q
    195 TOTAL   ;Display record total on the report
    196         N IVMTOTAL
    197         S IVMTOTAL=$G(^TMP($J,"IVMLDEM9","TOTAL"))
    198         D
    199         . D LNPLUS
    200         . S ^TMP($J,"IVMLDEM9",IVMLN)=""
    201         . D LNPLUS
    202         . S ^TMP($J,"IVMLDEM9",IVMLN)="TOTAL RECORD(S): "_$G(IVMTOTAL)
    203         Q
    204 LNPLUS  ;Increase line number for the email text
    205         S IVMLN=$G(IVMLN)+1
    206         Q
     1IVMLDEM9 ;ALB/BRM/PHH - IVM ADDRESS UPDATES PENDING REVIEW RPT ; 10/18/06 12:47pm
     2 ;;2.0;INCOME VERIFICATION MATCH;**79,93,119**; 21-OCT-94;Build 1
     3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
     4 ;
     5 Q
     6 ;
     7EN2 ;entry point for IVM ADDR UPDT PENDING REVIEW menu option
     8 K ^TMP("IVMLDEM9",$J)
     9 K ^TMP($J,"IVMLDEM9")
     10 ;If mail group has no member or remote-member
     11 I '$$MEMBER() D  Q
     12 . I '$D(ZTQUEUED) W !!,"IVM ADDR UPDT REPORT does not have a member. Report not sent." K DIR S DIR(0)="E" D ^DIR K DIR
     13 I +$G(ZTSK) D PRINT,EXIT Q  ;started by Taskman job
     14 ;User runs the option
     15 I '$D(ZTQUEUED) D
     16 . W !!,"The report will be sent to mail group IVM ADDR UPDT REPORT"
     17 . D QUE
     18 . D EXIT
     19 . K DIR S DIR(0)="E" D ^DIR K DIR
     20 Q
     21 ;
     22LOOP(DTPARAM,FILDAT) ;main loop
     23 N DFN,IVMDT,IVMDA,IVMDA1,IVMDA2,RF171,TODAY,AUTODT,DTDIFF,NAME,UPLDT
     24 N X1,X2,Y,SSN,DFN
     25 D DT^DILF("X","T"_$G(DTPARAM),.AUTODT)
     26 S TODAY=$$DT^XLFDT S:'$G(FILDAT) FILDAT=0
     27 Q:'$G(AUTODT)  ;this should never occur, but just in case
     28 S RF171=$O(^IVM(301.92,"C","RF171","")),IVMDA2=""
     29 Q:'RF171
     30 F  S IVMDA2=$O(^IVM(301.5,IVMDA2)) Q:IVMDA2=""  D
     31 .S DFN=$P($G(^IVM(301.5,IVMDA2,0)),"^"),IVMDA1=""
     32 .Q:('DFN)!('$D(^DPT(+DFN)))!('$D(^IVM(301.5,IVMDA2,"IN")))
     33 .F  S IVMDA1=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1)) Q:IVMDA1=""  D
     34 ..Q:'$D(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",RF171))
     35 ..S IVMDA=""
     36 ..F  S IVMDA=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",RF171,IVMDA)) Q:'IVMDA  D
     37 ...S IVMDT=$P($G(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMDA,0)),"^",3)
     38 ...Q:('IVMDT)!(IVMDT>AUTODT)
     39 ...; report addresses that will be auto-uploaded in DTDIFF days
     40 ...S X1=TODAY,X2=IVMDT D ^%DTC S DTDIFF=+$G(X)
     41 ...S NAME=$P($G(^DPT(DFN,0)),"^"),SSN=$P($G(^DPT(DFN,0)),"^",9)
     42 ...S X1=IVMDT,X2=14 D C^%DTC S UPLDT=$G(X)
     43 ...S ^TMP("IVMLDEM9",$J,DTDIFF,SSN,IVMDA)=$G(NAME)_"^"_$P(IVMDT,".")_"^"_$P(UPLDT,".")_"^"_DFN_"^"_IVMDA2_"^"_IVMDA1
     44 Q
     45 ;
     46AUTOLOAD(DFN,IVMDA2,IVMDA1) ;auto-upload records that not been reviewed
     47 ; this tag is called from ^IVMLDEMC
     48 ;
     49 Q:('$G(DFN))!('$G(IVMDA2))!('$G(IVMDA1))
     50 N IVMI,IVMJ,IVMFIELD,IVMVALUE,IVMNODE,IVMFLAG,DUZ
     51 S DUZ="IVM AUTO ADDR JOB"
     52 ;
     53 ; determine appropriate address change dt/tm to be used
     54 D ADDRDT^IVMLDEM6(DFN,IVMDA2,IVMDA1)
     55 ;
     56 N DGPRIOR D GETPRIOR^DGADDUTL(DFN,.DGPRIOR)
     57 ;
     58 ; loop through the record to be uploaded
     59 S IVMI=0 F  S IVMI=$O(^IVM(301.92,"AD",IVMI)) Q:IVMI']""  D
     60 .S IVMJ=0 F  S IVMJ=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IVMI,IVMJ)) Q:IVMJ']""  D
     61 ..;
     62 ..; check for data node in (#301.511) sub-file
     63 ..S IVMNODE=$G(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMJ,0))
     64 ..Q:('+IVMNODE)!($P(IVMNODE,"^",2)']"")
     65 ..;
     66 ..; check for residence phone number -> do not auto-upload
     67 ..Q:(+IVMNODE=$O(^IVM(301.92,"B","PHONE NUMBER [RESIDENCE]",0)))
     68 ..;
     69 ..; do not auto-upload if there is an active prescription
     70 ..I $$PHARM^IVMLDEM6(+DFN) D REJTADD Q
     71 ..;
     72 ..; set upload parameters
     73 ..S IVMFIELD=$P($G(^IVM(301.92,+IVMNODE,0)),"^",5)
     74 ..S IVMVALUE=$P(IVMNODE,"^",2)
     75 ..;
     76 ..; load addr field into the Patient (#2) file
     77 ..D UPLOAD^IVMLDEM6(DFN,IVMFIELD,IVMVALUE) S IVMFLAG=1
     78 ..;
     79 ..; remove entry from (#301.511) sub-file
     80 ..D DELENT^IVMLDEMU(IVMDA2,IVMDA1,IVMJ)
     81 ..;
     82 ..; if no display or uploadable fields, delete PID segment
     83 ..I ('$$DEMO^IVMLDEM5(IVMDA2,IVMDA1,0))&('$$DEMO^IVMLDEM5(IVMDA2,IVMDA1,1)) D DELETE^IVMLDEM5(IVMDA2,IVMDA1," ")
     84 ;
     85 I +$G(IVMFLAG) D
     86 .N DGCURR
     87 .D GETUPDTS^DGADDUTL(DFN,.DGCURR)
     88 .D UPDADDLG^DGADDUTL(DFN,.DGPRIOR,.DGCURR)
     89 Q
     90REJTADD ;Reject the address
     91 ; update the ADDRESS CHANGE DT/TM field #.118 in PATIENT file #2
     92 D UPDDTTM^DGADDUTL(DFN,"PERM")
     93 ;
     94 ; trigger the record to transmit the existing address on file to HEC
     95 N DGENUPLD   ; Used in SETSTAT^IVMPLOG to prevent filing.
     96 N DA,X,IVMX
     97 S (DA,X)=DFN
     98 S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX
     99 Q
     100PRINT ;report output
     101 N DAYS,SSN,DATA,EX,PAGE,IVMDA,DATA,IVMLN,XMY,XMSUB,XMDUZ,XMTEXT
     102 D LOOP("",0)
     103 D HDR
     104 D DISPLAY
     105 D EMAIL
     106 Q
     107DISPLAY ;Display the report
     108 S DAYS=""
     109 I '$D(^TMP("IVMLDEM9",$J)) Q
     110 F  S DAYS=$O(^TMP("IVMLDEM9",$J,DAYS),-1) Q:DAYS=""!($G(EX))  D
     111 .S SSN=""
     112 .F  S SSN=$O(^TMP("IVMLDEM9",$J,DAYS,SSN)) Q:SSN=""!($G(EX))  D
     113 ..S IVMDA=""
     114 ..F  S IVMDA=$O(^TMP("IVMLDEM9",$J,DAYS,SSN,IVMDA)) Q:(IVMDA="")!($G(EX))  D
     115 ...S DATA=$G(^TMP("IVMLDEM9",$J,DAYS,SSN,IVMDA))
     116 ... D LNPLUS
     117 ... S ^TMP($J,"IVMLDEM9",IVMLN)="       "_$$FMTE^XLFDT($P(DATA,"^",3))_"      "_$$FMTE^XLFDT($P(DATA,"^",2))_"      "_SSN_"     "_$P(DATA,"^")
     118 ... S ^TMP($J,"IVMLDEM9","TOTAL")=$G(^TMP($J,"IVMLDEM9","TOTAL"))+1
     119 D TOTAL
     120 D
     121 . D LNPLUS
     122 . S ^TMP($J,"IVMLDEM9",IVMLN)=""
     123 . D LNPLUS
     124 . S ^TMP($J,"IVMLDEM9",IVMLN)="                    <<END OF REPORT>>"
     125 I $E(IOST)="C" W ! K DIR S DIR(0)="E" D ^DIR K DIR
     126 Q
     127HDR ;print header
     128 N IVMDT,Y,DLINE
     129 I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,EX)=1 Q
     130 S Y=DT X ^DD("DD") S IVMDT=Y
     131 D
     132 . D LNPLUS
     133 . S ^TMP($J,"IVMLDEM9",IVMLN)=""
     134 . D LNPLUS
     135 . S ^TMP($J,"IVMLDEM9",IVMLN)=" IVM ADDRESS UPDATES PENDING REVIEW          "_IVMDT
     136 . D LNPLUS
     137 . S $P(^TMP($J,"IVMLDEM9",IVMLN),"=",78)=""
     138 . D LNPLUS
     139 . S ^TMP($J,"IVMLDEM9",IVMLN)=""
     140 . D LNPLUS
     141 . S ^TMP($J,"IVMLDEM9",IVMLN)="     Auto-Upload Date    Date Received        SSN        Patient Name"
     142 . D LNPLUS
     143 . S ^TMP($J,"IVMLDEM9",IVMLN)="     ----------------    -------------     ---------     ------------"
     144 Q
     145EXIT D ^%ZISC,HOME^%ZIS Q
     146 K ^TMP($J,"IVMLDEM9")
     147 K ^TMP("IVMLDEM9",$J)
     148 ;
     149ADRDTCK(DFN,IVMDA2,IVMDA1) ;is the incoming address older than #2 address?
     150 Q:'$G(DFN)!('$G(IVMDA2))!('$G(IVMDA1)) "0^MISSING INPUT PARAMETER"
     151 N OADDRDT,NADDRDT,ERR,IVMDA,IEN92,IENS
     152 S OADDRDT=$$GET1^DIQ(2,DFN_",",.118,"I","","ERR") Q:$D(ERR) "0^OLD ADDR ERROR"
     153 S IEN92=$O(^IVM(301.92,"C","RF171","")) Q:'IEN92 "0^BAD #301.92 ENTRY FOR RF171"
     154 I '$D(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IEN92)) Q "0^ADDR DT NOT PRESENT"
     155 S IVMDA=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IEN92,"")) Q:'IVMDA "0^MISSING ADDR DT IN 301.5"
     156 S IENS=IVMDA_","_IVMDA1_","_IVMDA2_","
     157 S NADDRDT=$$GET1^DIQ(301.511,IENS,.02,"I","","ERR") Q:$D(ERR) "0^NEW ADDR ERROR"
     158 Q:(OADDRDT="")&(NADDRDT="") 0
     159 Q:(NADDRDT="")!(OADDRDT'<NADDRDT) 1
     160 Q "0^INCOMING ADDRESS IS NEWER THAN PATIENT FILE ADDR"
     161MEMBER() ;Return 0 if mail group has no local or remote member
     162 N RESULT,IVMIEN,IVMRMT
     163 S RESULT=1
     164 S IVMIEN=$$FIND1^DIC(3.8,"","X","IVM ADDR UPDT REPORT")
     165 D LIST^DIC(3.812,","_IVMIEN_",",.01,"P","","","","","","","IVMRMT")
     166 I ($P($G(IVMRMT("DILIST",0)),U)'>0),('$$GOTLOCAL^XMXAPIG("IVM ADDR UPDT REPORT")) S RESULT=0
     167 Q RESULT
     168EMAIL ;Set up parameters to email the report
     169 ;If called within a task, protect variables
     170 I $D(ZTQUEUED) N %,DIFROM
     171 N RDT
     172 D NOW^%DTC S Y=% X ^DD("DD")
     173 S RDT=$P(Y,"@",1)_"@"_$P($P(Y,"@",2),":",1,2)
     174 S XMSUB="IVM Address Pending Review ("_RDT_")"
     175 S XMY("G.IVM ADDR UPDT REPORT")=""
     176 I $G(^TMP($J,"IVMLDEM9","TOTAL"))<1 D
     177 . D LNPLUS
     178 . S ^TMP($J,"IVMLDEM9",IVMLN)=""
     179 . D LNPLUS
     180 . S ^TMP($J,"IVMLDEM9",IVMLN)="*** NO RECORDS TO PRINT ***"
     181 S XMTEXT="^TMP($J,""IVMLDEM9"","
     182 D ^XMD
     183 Q
     184QUE ;Que the task if user invokes option
     185 N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZUSR,POP,X,ERR,IOP
     186 W !
     187 S ZTIO=""
     188 S ZTRTN="PRINT^IVMLDEM9"
     189 S ZTDESC="IVM AUTO ADDRESS UPLOAD RPT"
     190 D ^%ZTLOAD
     191 D ^%ZISC,HOME^%ZIS
     192 W !,$S($D(ZTSK):"REQUEST QUEUED AS TASK#"_ZTSK,1:"REQUEST CANCELLED!")
     193 Q
     194TOTAL ;Display record total on the report
     195 N IVMTOTAL
     196 S IVMTOTAL=$G(^TMP($J,"IVMLDEM9","TOTAL"))
     197 D
     198 . D LNPLUS
     199 . S ^TMP($J,"IVMLDEM9",IVMLN)=""
     200 . D LNPLUS
     201 . S ^TMP($J,"IVMLDEM9",IVMLN)="TOTAL RECORD(S): "_$G(IVMTOTAL)
     202 Q
     203LNPLUS ;Increase line number for the email text
     204 S IVMLN=$G(IVMLN)+1
     205 Q
Note: See TracChangeset for help on using the changeset viewer.