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/CLINICAL_REMINDERS-PXRM/PXRMPDR.m

    r613 r623  
    1 PXRMPDR ;SLC/AGP,PKR - Patient List Demographic report main routine ;11/16/2007
    2         ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
    3         ;
    4 EN(PLIEN)       ; -- main entry point for PXRM PATIENT LIST DEMOGRAPHIC
    5         N ARRAY,DC,DDATA,DELIM,DTOUT,DUOUT
    6         W @IOF
    7         K ^TMP("PXRMPLD",$J),^TMP("PXRMPLN",$J)
    8         S DELIM=0
    9 OPTION  ;
    10         W !,"Select the items to include on the report."
    11 ADDSEL  D ADDSEL^PXRMPDRS(.DDATA,"ADD")
    12         I $D(DTOUT)!$D(DUOUT) Q
    13 APPSEL  D APPSEL^PXRMPDRS(.DDATA,"APP")
    14         I $D(DTOUT)!$D(DUOUT) G ADDSEL
    15 DEMSEL  D DEMSEL^PXRMPDRS(.DDATA,"DEM")
    16         I $D(DTOUT)!$D(DUOUT) G APPSEL
    17 PFACSEL S DDATA("PFAC",0)=$$ASKYN^PXRMEUT("N","Include the patient's preferred facility")
    18         I $D(DTOUT)!$D(DUOUT) G DEMSEL
    19         S DDATA("PFAC","LEN")=$S(DDATA("PFAC",0)=1:1,1:0)
    20 ELIGSEL D ELIGSEL^PXRMPDRS(.DDATA,"ELIG")
    21         I $D(DTOUT)!$D(DUOUT) G PFACSEL
    22 DATASEL D DATASEL^PXRMPDRS(PLIEN,.DDATA,"FIND")
    23         I $D(DTOUT)!$D(DUOUT) G ELIGSEL
    24 INPSEL  D INPSEL^PXRMPDRS(.DDATA,"INP")
    25         I $D(DTOUT)!$D(DUOUT) G DATASEL
    26 REMDATA D REMSEL^PXRMPDRS(PLIEN,.DDATA,"REM")
    27         I $D(DTOUT)!$D(DUOUT) G INPSEL
    28         S DELIM=$$ASKYN^PXRMEUT("Y","Delimited Report:")
    29         I $D(DTOUT)!$D(DUOUT) G REMDATA
    30         S DC=$S(DELIM:$$DELIMSEL^PXRMXSD,1:U)
    31         I $D(DTOUT)!$D(DUOUT) G OPTION
    32 DEVICE  ;
    33         N DESC,DIR,PXRMQUE,RTN,SAVE,%ZIS
    34         S %ZIS="M"
    35         S DESC="Patient List Demographic Report"
    36         S RTN="GETPDATA^PXRMPDR(DELIM,DC,PLIEN,.DDATA)"
    37         S SAVE("DELIM")="",SAVE("DC")="",SAVE("PLIEN")=""
    38         S SAVE("DDATA(")=""
    39         S PXRMQUE=$$DEVICE^PXRMXQUE(RTN,DESC,.SAVE,.%ZIS,1)
    40         I PXRMQUE'="" G EXIT
    41         I $D(DTOUT)!$D(DUOUT) G EXIT
    42         S DIR(0)="E" D ^DIR
    43 EXIT    D KVA^VADPT
    44         K ^TMP("PXRMPLD",$J),^TMP("PXRMPLN",$J)
    45         Q
    46         ;
    47 GETPDATA(DELIM,DC,PLIEN,DDATA)  ;
    48         N DATA,DATE,DCREAT,DFN,DTYPE,ERRMSG
    49         N GETADD,GETAPP,GETDEM,GETELIG,GETFIND,GETINP,GETREM
    50         N IEN,IND,JND,KND,LND
    51         N LISTNAME,PIECE
    52         N PDATA,PNAME,RIEN,TDATA
    53         K ^TMP("PXRMPD",$J)
    54         S LISTNAME=$P(^PXRMXP(810.5,PLIEN,0),U,1)
    55         S DCREAT=$P(^PXRMXP(810.5,PLIEN,0),U,4)
    56         S GETDEM=$S(DDATA("DEM","LEN")>0:1,1:0)
    57         S GETADD=$S(DDATA("ADD","LEN")>0:1,1:0)
    58         S GETINP=$S(DDATA("INP","LEN")>0:1,1:0)
    59         S GETELIG=$S(DDATA("ELIG","LEN")>0:1,1:0)
    60         S GETAPP=$S(DDATA("APP","LEN")>0:1,1:0)
    61         S GETFIND=$S(DDATA("FIND","LEN")>0:1,1:0)
    62         S GETREM=$S(DDATA("REM","LEN")>0:1,1:0)
    63         S IEN=0
    64         F  S IEN=+$O(^PXRMXP(810.5,PLIEN,30,IEN)) Q:IEN=0  D
    65         . S DFN=$P(^PXRMXP(810.5,PLIEN,30,IEN,0),U,1) I DFN="" Q
    66         .;#DBIA 10035
    67         . S PNAME=$P($G(^DPT(DFN,0)),U,1)
    68         . I PNAME="" S PNAME="UNDEFINED"_DFN
    69         . S ^TMP("PXRMPLN",$J,PNAME,DFN)=""
    70         . S PDATA=""
    71         . I GETDEM D
    72         .. N VADM
    73         .. D DEM^VADPT
    74         .. F IND=1:1:DDATA("DEM","LEN") D
    75         ... S JND=$P(DDATA("DEM"),",",IND)
    76         ... S KND=0
    77         ... F  S KND=$O(DDATA("DEM",JND,KND)) Q:KND=""  D
    78         .... S PIECE=$P(DDATA("DEM",JND,KND),U,2)
    79         .... S TDATA=$P(VADM(KND),U,PIECE)
    80         .... S LND=""
    81         .... F  S LND=$O(VADM(KND,LND)) Q:LND=""  D
    82         ..... I TDATA'="" S TDATA=TDATA_"~"
    83         ..... S TDATA=TDATA_$P(VADM(KND,LND),U,PIECE)
    84         .... I KND=2,'DDATA("DEM","FULLSSN") S TDATA=$E(TDATA,8,11)
    85         .... S $P(PDATA,U,KND)=TDATA
    86         .. I PDATA'="" S ^TMP("PXRMPLD",$J,DFN,"DEM")=PDATA,PDATA=""
    87         . I DDATA("PFAC",0)=1 D
    88         ..;DBIA #1850
    89         .. S TDATA=$$GET1^DIQ(2,DFN,27.02,"E","","ERRMSG")
    90         .. I TDATA="" S TDATA="NONE"
    91         .. S ^TMP("PXRMPLD",$J,DFN,"PFAC")=TDATA
    92         . I GETADD D
    93         .. N VAPA
    94         .. D ADD^VADPT
    95         .. F IND=1:1:DDATA("ADD","LEN") D
    96         ... S JND=$P(DDATA("ADD"),",",IND)
    97         ... S KND=0
    98         ... F  S KND=$O(DDATA("ADD",JND,KND)) Q:KND=""  D
    99         .... S PIECE=$P(DDATA("ADD",JND,KND),U,2)
    100         .... S TDATA=$P(VAPA(KND),U,PIECE)
    101         .... S $P(PDATA,U,KND)=TDATA
    102         .. I PDATA'="" S ^TMP("PXRMPLD",$J,DFN,"ADD")=PDATA,PDATA=""
    103         . I GETINP D
    104         .. N VAIP
    105         .. D INP^VADPT
    106         .. F IND=1:1:DDATA("INP","LEN") D
    107         ... S JND=$P(DDATA("INP"),",",IND)
    108         ... S KND=0
    109         ... F  S KND=$O(DDATA("INP",JND,KND)) Q:KND=""  D
    110         .... S PIECE=$P(DDATA("INP",JND,KND),U,2)
    111         .... S TDATA=$P(VAIN(KND),U,PIECE)
    112         .... S $P(PDATA,U,KND)=TDATA
    113         .. I PDATA'="" S ^TMP("PXRMPLD",$J,DFN,"INP")=PDATA,PDATA=""
    114         . I GETELIG D
    115         .. N VAEL
    116         .. D ELIG^VADPT
    117         .. F IND=1:1:DDATA("ELIG","LEN") D
    118         ... S JND=$P(DDATA("ELIG"),",",IND)
    119         ... S KND=0
    120         ... F  S KND=$O(DDATA("ELIG",JND,KND)) Q:KND=""  D
    121         .... S PIECE=$P(DDATA("ELIG",JND,KND),U,2)
    122         .... S TDATA=$P(VAEL(KND),U,PIECE)
    123         .... I KND=4 S TDATA=$S(TDATA=1:"YES",1:"NO")
    124         .... S $P(PDATA,U,KND)=TDATA
    125         .. I PDATA'="" S ^TMP("PXRMPLD",$J,DFN,"ELIG")=PDATA,PDATA=""
    126         . D KVA^VADPT
    127         . I GETREM D
    128         .. S IND=0
    129         .. F  S IND=$O(DDATA("REM","IEN",IND)) Q:IND=""  D
    130         ... S PDATA=$G(^PXRMXP(810.5,PLIEN,30,IEN,"REM",IND,0))
    131         ... I PDATA="" Q
    132         ... S RIEN=$P(PDATA,U,1)
    133         ... S ^TMP("PXRMPLD",$J,DFN,"REM",RIEN)=PDATA,PDATA=""
    134         . I GETFIND D
    135         .. N DL
    136         .. F IND=1:1:DDATA("FIND","LEN") D
    137         ... S JND=$P(DDATA("FIND"),",",IND)
    138         ... S DTYPE=DDATA("FIND",JND,JND)
    139         ... S KND=$O(^PXRMXP(810.5,PLIEN,30,IEN,"DATA","B",DTYPE,""))
    140         ... S DL=$S(KND="":0,1:$L(^PXRMXP(810.5,PLIEN,30,IEN,"DATA",KND,0),U))
    141         ... S DATA=$S(KND="":"",1:$P(^PXRMXP(810.5,PLIEN,30,IEN,"DATA",KND,0),U,2,DL))
    142         ... S ^TMP("PXRMPLD",$J,DFN,"FIND",JND)=DATA
    143         ;Get appointment data for all patients on the list.
    144         I GETAPP D
    145         . N ARRAY,COUNT
    146         . S ARRAY(1)=DT,ARRAY(3)="I;R"
    147         . S ARRAY(4)="^TMP($J,""PXRMPL""",ARRAY("FLDS")=""
    148         . F IND=1:1:DDATA("APP","LEN") D
    149         .. S JND=$P(DDATA("APP"),",",IND)
    150         .. S KND=0
    151         .. F  S KND=$O(DDATA("APP",JND,KND)) Q:KND=""  S ARRAY("FLDS")=ARRAY("FLDS")_KND_";"
    152         . K ^TMP($J,"PXRMPL"),^TMP($J,"SDAMA301")
    153         . S IND=0
    154         . F  S IND=+$O(^PXRMXP(810.5,PLIEN,30,IND)) Q:IND=0  D
    155         .. S DFN=$P(^PXRMXP(810.5,PLIEN,30,IND,0),U,1)
    156         .. I DFN'="" S ^TMP($J,"PXRMPL",DFN)=""
    157         . S COUNT=$$SDAPI^SDAMA301(.ARRAY)
    158         . I COUNT=-1 D  Q
    159         .. D APPERR^PXRMPDRS
    160         .. S DDATA("APP","ERROR")=""
    161         .. K ^TMP($J,"PXRMPL"),^TMP($J,"SDAMA301")
    162         . F IND=1:1:COUNT D
    163         .. S DFN=""
    164         .. F  S DFN=$O(^TMP($J,"SDAMA301",DFN)) Q:DFN=""  D
    165         ... S (JND,KND)=0
    166         ... F  S JND=$O(^TMP($J,"SDAMA301",DFN,JND)) Q:JND=""  D
    167         .... S DATE=0
    168         .... F  S DATE=$O(^TMP($J,"SDAMA301",DFN,JND,DATE)) Q:DATE=""  D
    169         ..... S KND=KND+1
    170         ..... S TDATA=^TMP($J,"SDAMA301",DFN,JND,DATE)
    171         ..... S PDATA=$$FMTE^XLFDT($P(TDATA,U,1))
    172         ..... S TDATA=$P(TDATA,U,2),TDATA=$P(TDATA,";",2)
    173         ..... S PDATA=PDATA_U_TDATA
    174         ..... S ^TMP("PXRMPLD",$J,DFN,"APP",KND)=PDATA
    175         . K ^TMP($J,"PXRMPL"),^TMP($J,"SDAMA301")
    176         I DELIM=1 D DELIMPR^PXRMPDRP(DC,PLIEN,.DDATA)
    177         I DELIM=0 D REGPR^PXRMPDRP(PLIEN,.DDATA)
    178         Q
    179         ;
    180 LENGTH(STR,STR1)        ;
    181         I ($L(STR)+$L(STR1))>245 W !,STR S STR=STR1
    182         E  S STR=STR_U_STR1,STR1=""
    183         Q
    184         ;
    185 PAGE    ;
    186         I ($E(IOST,1,2)="C-")&(IO=IO(0)) D
    187         .S DIR(0)="E"
    188         .W !
    189         .D ^DIR K DIR
    190         I $D(DUOUT)!($D(DTOUT))!($D(DIROUT)) S DONE=1 Q
    191         W:$D(IOF) @IOF
    192         S PAGE=PAGE+1
    193         I ($E(IOST,1,2)="C-")&(IO=IO(0)) W @IOF
    194         Q
    195         ;
     1PXRMPDR ;SLC/AGP,PKR - Patient List Demographic report main routine ;07/17/2006
     2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
     3 ;
     4EN(PLIEN) ; -- main entry point for PXRM PATIENT LIST DEMOGRAPHIC
     5 N ADDDATA,APPDATA,ARRAY,BACK,CNT,DC,DEMDATA,DELIM,DIC,DIR,DTOUT,DUOUT
     6 N ELIGDATA,IEN,INPDATA
     7 N FINDDATA,NAME,NODE,PFACDATA,PTIEN
     8 N QUIT,REMDATA
     9 N X,Y,YESNO
     10 W @IOF
     11 K ^TMP("PXRMPLD",$J),^TMP("PXRMPLN",$J)
     12 S BACK=0,DELIM=0,QUIT=0
     13OPTION ;
     14 W !,"Select the items to include on the report."
     15ADDSEL D ADDSEL^PXRMPDRS(.ADDDATA)
     16 I $D(DTOUT)!$D(DUOUT) Q
     17APPSEL D APPSEL^PXRMPDRS(.APPDATA)
     18 I $D(DTOUT)!$D(DUOUT) G ADDSEL
     19DEMSEL D DEMSEL^PXRMPDRS(.DEMDATA)
     20 I $D(DTOUT)!$D(DUOUT) G APPSEL
     21PFACSEL S PFACDATA(0)=$$ASKYN^PXRMEUT("N","Include the patient's preferred facility")
     22 I $D(DTOUT)!$D(DUOUT) G DEMSEL
     23 S PFACDATA("LEN")=$S(PFACDATA(0)=1:1,1:0)
     24ELIGSEL D ELIGSEL^PXRMPDRS(.ELIGDATA)
     25 I $D(DTOUT)!$D(DUOUT) G PFACSEL
     26DATASEL D DATASEL^PXRMPDRS(PLIEN,.FINDDATA)
     27 I $D(DTOUT)!$D(DUOUT) G ELIGSEL
     28INPSEL D INPSEL^PXRMPDRS(.INPDATA)
     29 I $D(DTOUT)!$D(DUOUT) G DATASEL
     30REMDATA D REMSEL^PXRMPDRS(PLIEN,.REMDATA)
     31 I $D(DTOUT)!$D(DUOUT) G INPSEL
     32 S DELIM=$$ASKYN^PXRMEUT("Y","Delimited Report:")
     33 I $D(DTOUT)!$D(DUOUT) G REMDATA
     34 I DELIM S DC=$$DELIMSEL^PXRMXSD
     35 I $D(DTOUT)!$D(DUOUT) G OPTION
     36DEVICE ;
     37 N DIR,PXRMQUE,%ZIS,ZTDESC,ZTRTN,ZTSAVE
     38 S %ZIS="M"
     39 S ZTDESC="Patient List Demographic"
     40 S ZTRTN="GETDATA^PXRMPDR(DELIM,PLIEN,.DEMDATA,.PFACDATA,.ADDDATA,.INPDATA,.APPDATA,.FINDDATA,.REMDATA)"
     41 S ZTSAVE("*")=""
     42 S PXRMQUE=0
     43 S PXRMQUE=$$DEVICE^PXRMXQUE(ZTRTN,ZTDESC,.ZTSAVE,.%ZIS,.ZTSK)
     44 I PXRMQUE=1 G EXIT
     45 I $D(DTOUT)!$D(DUOUT) G EXIT
     46 ;
     47 S DIR(0)="E" D ^DIR
     48EXIT D KVA^VADPT
     49 K ^TMP("PXRMPLD",$J),^TMP("PXRMPLN",$J)
     50 Q
     51 ;
     52GETDATA(DELIM,PLIEN,DEMDATA,PFACDATA,ADDDATA,INPDATA,APPDATA,FINDDATA,REMDATA) ;
     53 N DATA,DATE,DCREAT,DFN,DTYPE,ERRMSG
     54 N GETADD,GETAPP,GETDEM,GETELIG,GETFIND,GETINP,GETREM
     55 N IEN,IND,JND,KND,LND
     56 N LISTNAME,PIECE
     57 N PDATA,PNAME,RIEN,TDATA
     58 K ^TMP("PXRMPD",$J)
     59 S LISTNAME=$P(^PXRMXP(810.5,PLIEN,0),U,1)
     60 S DCREAT=$P(^PXRMXP(810.5,PLIEN,0),U,4)
     61 S GETDEM=$S(DEMDATA("LEN")>0:1,1:0)
     62 S GETADD=$S(ADDDATA("LEN")>0:1,1:0)
     63 S GETINP=$S(INPDATA("LEN")>0:1,1:0)
     64 S GETELIG=$S(ELIGDATA("LEN")>0:1,1:0)
     65 S GETAPP=$S(APPDATA("LEN")>0:1,1:0)
     66 S GETFIND=$S(FINDDATA("LEN")>0:1,1:0)
     67 S GETREM=$S(REMDATA("LEN")>0:1,1:0)
     68 S IEN=0
     69 F  S IEN=+$O(^PXRMXP(810.5,PLIEN,30,IEN)) Q:IEN=0  D
     70 . S DFN=$P(^PXRMXP(810.5,PLIEN,30,IEN,0),U,1) I DFN="" Q
     71 .;#DBIA 10035
     72 . S PNAME=$P($G(^DPT(DFN,0)),U,1)
     73 . I PNAME="" S PNAME="UNDEFINED"_DFN
     74 . S ^TMP("PXRMPLN",$J,PNAME,DFN)=""
     75 . S PDATA=""
     76 . I GETDEM D
     77 .. N VADM
     78 .. D DEM^VADPT
     79 .. F IND=1:1:DEMDATA("LEN") D
     80 ... S JND=$P(DEMDATA,",",IND)
     81 ... S KND=0
     82 ... F  S KND=$O(DEMDATA(JND,KND)) Q:KND=""  D
     83 .... S PIECE=$P(DEMDATA(JND,KND),U,2)
     84 .... S TDATA=$P(VADM(KND),U,PIECE)
     85 .... S LND=""
     86 .... F  S LND=$O(VADM(KND,LND)) Q:LND=""  D
     87 ..... I TDATA'="" S TDATA=TDATA_"~"
     88 ..... S TDATA=TDATA_$P(VADM(KND,LND),U,PIECE)
     89 .... I KND=2,'DEMDATA("FULLSSN") S TDATA=$E(TDATA,8,11)
     90 .... S $P(PDATA,U,KND)=TDATA
     91 .. I PDATA'="" S ^TMP("PXRMPLD",$J,DFN,"DEMDATA")=PDATA,PDATA=""
     92 . I PFACDATA(0)=1 D
     93 ..;DBIA #1850
     94 .. S TDATA=$$GET1^DIQ(2,DFN,27.02,"E","","ERRMSG")
     95 .. I TDATA="" S TDATA="NONE"
     96 .. S ^TMP("PXRMPLD",$J,DFN,"PFACDATA")=TDATA
     97 . I GETADD D
     98 .. N VAPA
     99 .. D ADD^VADPT
     100 .. F IND=1:1:ADDDATA("LEN") D
     101 ... S JND=$P(ADDDATA,",",IND)
     102 ... S KND=0
     103 ... F  S KND=$O(ADDDATA(JND,KND)) Q:KND=""  D
     104 .... S PIECE=$P(ADDDATA(JND,KND),U,2)
     105 .... S TDATA=$P(VAPA(KND),U,PIECE)
     106 .... S $P(PDATA,U,KND)=TDATA
     107 .. I PDATA'="" S ^TMP("PXRMPLD",$J,DFN,"ADDDATA")=PDATA,PDATA=""
     108 . I GETINP D
     109 .. N VAIP
     110 .. D INP^VADPT
     111 .. F IND=1:1:INPDATA("LEN") D
     112 ... S JND=$P(INPDATA,",",IND)
     113 ... S KND=0
     114 ... F  S KND=$O(INPDATA(JND,KND)) Q:KND=""  D
     115 .... S PIECE=$P(INPDATA(JND,KND),U,2)
     116 .... S TDATA=$P(VAIN(KND),U,PIECE)
     117 .... S $P(PDATA,U,KND)=TDATA
     118 .. I PDATA'="" S ^TMP("PXRMPLD",$J,DFN,"INPDATA")=PDATA,PDATA=""
     119 . I GETELIG D
     120 .. N VAEL
     121 .. D ELIG^VADPT
     122 .. F IND=1:1:ELIGDATA("LEN") D
     123 ... S JND=$P(ELIGDATA,",",IND)
     124 ... S KND=0
     125 ... F  S KND=$O(ELIGDATA(JND,KND)) Q:KND=""  D
     126 .... S PIECE=$P(ELIGDATA(JND,KND),U,2)
     127 .... S TDATA=$P(VAEL(KND),U,PIECE)
     128 .... I KND=4 S TDATA=$S(TDATA=1:"YES",1:"NO")
     129 .... S $P(PDATA,U,KND)=TDATA
     130 .. I PDATA'="" S ^TMP("PXRMPLD",$J,DFN,"ELIGDATA")=PDATA,PDATA=""
     131 . D KVA^VADPT
     132 . I GETREM D
     133 .. S IND=0
     134 .. F  S IND=$O(REMDATA("IEN",IND)) Q:IND=""  D
     135 ... S PDATA=$G(^PXRMXP(810.5,PLIEN,30,IEN,"REM",IND,0))
     136 ... I PDATA="" Q
     137 ... S RIEN=$P(PDATA,U,1)
     138 ... S ^TMP("PXRMPLD",$J,DFN,"REMDATA",RIEN)=PDATA,PDATA=""
     139 . I GETFIND D
     140 .. N DL
     141 .. F IND=1:1:FINDDATA("LEN") D
     142 ... S JND=$P(FINDDATA,",",IND)
     143 ... S DTYPE=FINDDATA(JND,JND)
     144 ... S KND=$O(^PXRMXP(810.5,PLIEN,30,IEN,"DATA","B",DTYPE,""))
     145 ... S DL=$S(KND="":0,1:$L(^PXRMXP(810.5,PLIEN,30,IEN,"DATA",KND,0),U))
     146 ... S DATA=$S(KND="":"",1:$P(^PXRMXP(810.5,PLIEN,30,IEN,"DATA",KND,0),U,2,DL))
     147 ... S ^TMP("PXRMPLD",$J,DFN,"FINDDATA",JND)=DATA
     148 ;Get appointment data for all patients on the list.
     149 I GETAPP D
     150 . N ARRAY,COUNT
     151 . S ARRAY(1)=DT,ARRAY(3)="I;R"
     152 . S ARRAY(4)="^TMP($J,""PXRMPL""",ARRAY("FLDS")=""
     153 . F IND=1:1:APPDATA("LEN") D
     154 .. S JND=$P(APPDATA,",",IND)
     155 .. S KND=0
     156 .. F  S KND=$O(APPDATA(JND,KND)) Q:KND=""  S ARRAY("FLDS")=ARRAY("FLDS")_KND_";"
     157 . K ^TMP($J,"PXRMPL"),^TMP($J,"SDAMA301")
     158 . S IND=0
     159 . F  S IND=+$O(^PXRMXP(810.5,PLIEN,30,IND)) Q:IND=0  D
     160 .. S DFN=$P(^PXRMXP(810.5,PLIEN,30,IND,0),U,1)
     161 .. I DFN'="" S ^TMP($J,"PXRMPL",DFN)=""
     162 . S COUNT=$$SDAPI^SDAMA301(.ARRAY)
     163 . I COUNT=-1 D  Q
     164 .. D APPERR^PXRMPDRS
     165 .. S APPDATA("ERROR")=""
     166 .. K ^TMP($J,"PXRMPL"),^TMP($J,"SDAMA301")
     167 . F IND=1:1:COUNT D
     168 .. S DFN=""
     169 .. F  S DFN=$O(^TMP($J,"SDAMA301",DFN)) Q:DFN=""  D
     170 ... S (JND,KND)=0
     171 ... F  S JND=$O(^TMP($J,"SDAMA301",DFN,JND)) Q:JND=""  D
     172 .... S DATE=0
     173 .... F  S DATE=$O(^TMP($J,"SDAMA301",DFN,JND,DATE)) Q:DATE=""  D
     174 ..... S KND=KND+1
     175 ..... S TDATA=^TMP($J,"SDAMA301",DFN,JND,DATE)
     176 ..... S PDATA=$$FMTE^XLFDT($P(TDATA,U,1))
     177 ..... S TDATA=$P(TDATA,U,2),TDATA=$P(TDATA,";",2)
     178 ..... S PDATA=PDATA_U_TDATA
     179 ..... S ^TMP("PXRMPLD",$J,DFN,"APPDATA",KND)=PDATA
     180 . K ^TMP($J,"PXRMPL"),^TMP($J,"SDAMA301")
     181 I DELIM=1 D DELIMPR^PXRMPDRP(DC,PLIEN,.ADDDATA,.APPDATA,.DEMDATA,.FINDDATA,.INPDATA,.PFACDATA,.REMDATA)
     182 I DELIM=0 D REGPR^PXRMPDRP(PLIEN,.ADDDATA,.APPDATA,.DEMDATA,.FINDDATA,.INPDATA,.PFACDATA,.REMDATA)
     183 Q
     184 ;
     185LENGTH(STR,STR1) ;
     186 I ($L(STR)+$L(STR1))>245 W !,STR S STR=STR1
     187 E  S STR=STR_U_STR1,STR1=""
     188 Q
     189 ;
     190PAGE ;
     191 I ($E(IOST)="C")&(IO=IO(0)) D
     192 .S DIR(0)="E"
     193 .W !
     194 .D ^DIR K DIR
     195 I $D(DUOUT)!($D(DTOUT))!($D(DIROUT)) S DONE=1 Q
     196 W:$D(IOF) @IOF
     197 S PAGE=PAGE+1
     198 I $E(IOST)="C",IO=IO(0) W @IOF
     199 Q
     200 ;
Note: See TracChangeset for help on using the changeset viewer.