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/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGDEATH.m

    r613 r623  
    1 DGDEATH ;ALB/MRL/PJR-PROCESS DECEASED PATIENTS ; 10/27/04 9:45pm
    2         ;;5.3;Registration;**45,84,101,149,392,545,595,568,563,725,772**;Aug 13, 1993;Build 4
    3         ;
    4 GET     N DGMTI,DATA
    5         S DGDTHEN="" W !! S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G Q:Y'>0 S (DA,DFN)=+Y
    6         S DGDOLD=$G(^DPT(DFN,.35))
    7         I $D(^DPT(DFN,.1)) W !?3,"Patient is currently in-house.  Discharge him with a discharge type of DEATH." G GET
    8         I $S($D(^DPT(DFN,.35)):^(.35),1:"") F DGY=0:0 S DGY=$O(^DGPM("ATID1",DFN,DGY)) Q:'DGY  S DGDA=$O(^(DGY,0)) I $D(^DGPM(+DGDA,0)),$P(^(0),"^",17)]"" S DGXX=$P(^(0),"^",17),DGXX=^DGPM(DGXX,0) I "^12^38^"[("^"_$P(DGXX,"^",18)_"^") G DIS
    9         D NOW^%DTC S DGNOW=%
    10         S ^TMP("DEATH",$J)=1
    11         K A W ! S DIE=DIC,DR=".351" D ^DIE
    12         I '$D(^DPT(DFN,.35)) K ^TMP("DEATH",$J) G GET
    13         S DGDNEW=^DPT(DFN,.35)
    14         I $P(DGDNEW,"^",1)="",$P(DGDNEW,"^",2)'="" S DR=".352////@" D ^DIE
    15         I $P(DGDNEW,"^",1)="" K ^TMP("DEATH",$J) G GET
    16 SN      I $P(DGDNEW,"^",1)'="" S DR=".353" D ^DIE I $P($G(^DPT(DFN,.35)),"^",3)']"" D SNDISP G SN
    17         I DGDOLD'=DGDNEW D DISCHRGE
    18         I $P(DGDOLD,"^",1)'=$P(DGDNEW,"^",1) D XFR
    19         K ^TMP("DEATH",$J) G GET
    20         ;
    21 DIS     W !,"Patient has a discharge type of Death",!,"Edit the discharge",!
    22 Q       K A,DA,DFN,DGDA,DIC,DIE,DR,DGXX,DGY,DGDTHEN,DGDOLD,DGDNEW,DGDONOT Q
    23 XFR     ; called from set x-ref of field .351 of file 2
    24         N DGPCMM,DGFAPT,DGFAPTI,DGFAPT1
    25         Q:'$D(DFN)
    26         K DGTEXT D ^DGPATV S DGDEATH=$$GET1^DIQ(2,DFN,.351,"I"),XMSUB="PATIENT HAS EXPIRED",DGCT=0
    27         D DEMOG
    28         S DGT=X-.0001,(Y,DGDDT)=X,DG1="" D:DGT]"" ^DGPMSTAT
    29         S Y=$$FMTE^XLFDT(Y),Y=$S(Y]"":Y,1:"UNKNOWN")
    30         S DGDONOT=0 D APTT3
    31         D LINE("")
    32         D LINE("      Date/Time of Death: "_DEATHVAL_$S(DGDONOT:"",'DG1:"",$D(DGDTHEN):"",1:"  (While an inpatient)"))
    33         D LINE("")
    34         I '$D(ADM),DG1,$D(^DGPM(+DGA1,0)) S ADM=+^DGPM($P(^(0),"^",14),0)
    35         S Y=$$FMTE^XLFDT($S($D(ADM):ADM,1:""))
    36         D LINE($S($D(DGDTHEN):"",DG1:"     Admission Date/Time: "_Y_$S((DGDDT-ADM)<1:"  (Within 24 hours of hospitalization)",1:""),1:""))
    37         D LINE("")
    38         S DGX=$P($G(^DGPM(+$G(DGA1),0)),"^",6),DGX=$P($G(^DIC(42,+DGX,0)),U,1)
    39         D LINE($S($D(DGDTHEN):"",('DG1):"",$D(DGA1):"             Admitted To: "_$S(DGX]"":DGX,1:"UNKNOWN"),1:"")) K DGX
    40         D LINE("")
    41         I DG1&'$D(DGDTHEN) D
    42         . D LINE($S($D(DGXFR0):"           Last Transfer: "_$S($D(^DIC(42,+$P(DGXFR0,"^",6),0)):$P(^(0),"^"),1:"UNKNOWN"),1:""))
    43         . D LINE("")
    44 F       N DGARRAY,SDCNT S DGFAPT=DGDEATH,DGFAPTI=""
    45         S DGARRAY("FLDS")=3,DGARRAY(4)=DFN,DGARRAY("SORT")="P",DGARRAY(1)=DT,DGARRAY(3)="I;R"
    46         S SDCNT=$$SDAPI^SDAMA301(.DGARRAY)
    47         ;
    48         I SDCNT>0 F  S DGFAPT=$O(^TMP($J,"SDAMA301",DFN,DGFAPT)) Q:'DGFAPT  S DGFAPT1=$G(^TMP($J,"SDAMA301",DFN,DGFAPT)) Q:DGFAPT1']""  D  Q:DGFAPTI
    49         .I $P($P(DGFAPT1,U,3),";")'["C" D LINE("NOTE: Patient has future appointments scheduled!!") S DGFAPTI=1
    50         S DGSCHAD=0 D SA I DGSCHAD D LINE("NOTE: Patient had scheduled admissions which have been cancelled!!")
    51         I 'DGVETS D LINE("Patient is a NON-VETERAN."_$S($D(^DIC(21,+$P($G(^DPT(DFN,.32)),"^",3),0)):"  ["_$P(^(0),"^",1)_"]",1:""))
    52         S DGPCMM=$$PCMMXMY^SCAPMC25(1,DFN,,,0) ;creates xmy array
    53         S DGCT=$$PCMAIL^SCMCMM(DFN,"DGTEXT",DT)
    54 Q1      S DGB=1 D ^DGBUL S X=DGDEATH
    55         K DGDEATH,DGSCHAD,DGI,Y,DGDDT,^TMP($J,"SDAMA301") D KILL^DGPATV K ADM,DG1,DGA1,DGCT,DGT,DGXX,DGY,Z Q
    56 SA      F DGI=0:0 S DGI=$O(^DGS(41.1,"B",DFN,DGI)) Q:'DGI  I $D(^DGS(41.1,DGI,0)),($P(^(0),"^",13)']""),($P(^(0),"^",17)']"") S $P(^(0),"^",13)=DGDEATH,$P(^(0),"^",14)=+DUZ,$P(^(0),"^",15)=1,$P(^(0),"^",16)=2,DGSCHAD=1
    57         Q
    58         ;
    59 DEL     ; delete death bulletin
    60         N DGPCMM,DELBY,DELTM,DTHINFO
    61         S DFN=+$G(DA) I '$D(^DPT(DFN,0)) Q  ; no patient node
    62         I +$G(^DPT(DFN,.35)) Q  ; not deletion
    63         S DGDEATH=X,XMSUB="Patient Death has been Deleted",DGCT=0
    64         D ^DGPATV
    65         D LINE("The date of death for the following patient has been deleted.")
    66         D LINE("")
    67         D DEMOG
    68         D LINE("")
    69         S DGPCMM=$$PCMMXMY^SCAPMC25(1,DFN,,,0) ;creates xmy array
    70         S DGCT=$$PCMAIL^SCMCMM(DFN,"DGTEXT",DT)
    71         S DGB=1 D ^DGBUL S X=DGDEATH
    72         K DGCT,DGDEATH D KILL^DGPATV
    73         Q
    74         ;
    75 DEMOG   ; list main demographics
    76         D LINE("                    NAME: "_DGNAME)
    77         D LINE("                     SSN: "_$P(SSN,"^",2))
    78         D LINE("                     DOB: "_$P(DOB,"^",2))
    79         I DGVETS D
    80         . N DGX
    81         . S DGX=$G(^DPT(DFN,.31))
    82         . S DGLOCATN=$$FIND1^DIC(4,"","MX","`"_+$P(DGX,U,4)),DGLOCATN=$S(+DGLOCATN>0:$P($$NS^XUAF4(DGLOCATN),U),1:"NOT LISTED")
    83         . D LINE("   CLAIM FOLDER LOCATION: "_$S($D(DGLOCATN):DGLOCATN,1:"NOT LISTED"))
    84         . D LINE("            CLAIM NUMBER: "_$S($P(DGX,"^",3)]"":$P(DGX,"^",3),1:"NOT LISTED"))
    85         D LINE("   COORDINATING MASTER OF RECORD: "_DGCMOR)
    86         D GETS^DIQ(2,DFN_",",".351;.353;.354;.355","E","DTHINFO")
    87         S DEATHVAL=$G(DTHINFO(2,DFN_",",.351,"E"))
    88         S DEATHVAL=$$FMTE^XLFDT(DEATHVAL),DEATHVAL=$S(DEATHVAL]"":DEATHVAL,1:"UNKNOWN")
    89         S SOURCE=$G(DTHINFO(2,DFN_",",.353,"E"))
    90         S DELTM=$G(DTHINFO(2,DFN_",",.354,"E"))
    91         S DELBY=$G(DTHINFO(2,DFN_",",.355,"E"))
    92         D LINE("")
    93         D LINE("             LAST EDITED BY: "_DELBY)
    94         D LINE("    DATE/TIME LAST MODIFIED: "_DELTM)
    95         D LINE("     SOURCE OF NOTIFICATION: "_$S(SOURCE="":"UNDEFINED",1:SOURCE))
    96         ;K DEATHVAL,SOURCE,DELTM,DELBY
    97         Q
    98         ;
    99 LINE(X) ; add line contained in X to array
    100         S DGCT=DGCT+1
    101         S DGTEXT(DGCT,0)=X
    102         Q
    103 DSBULL  ;
    104         ;
    105         I $G(IVMDODUP)=1 Q
    106         S DFN=DA
    107         I $D(DGPMDA) D  Q
    108         .S DISTYPE=$P($G(^DGPM(DGPMDA,0)),"^",18)
    109         .I $G(^DG(405.2,DISTYPE,0))["DEATH" D
    110         ..S FDA(2,DFN_",",.353)=1 D FILE^DIE(,"FDA","BWFERR")
    111         ..D DISCHRGE,XFR
    112         I $D(^TMP("DEATH",$J)) Q
    113         D DISCHRGE,XFR
    114         Q
    115 DKBULL  ;
    116         S DFN=DA
    117         S FDA(2,DFN_",",.353)="@"
    118         I $D(^TMP("DEATH",$J)) S FDA(2,DFN_",",.355)=DUZ
    119         D FILE^DIE(,"FDA",)
    120         D DEL
    121         Q
    122 DISCHRGE        ;
    123         ; If the patient is being discharged, determine values needed for
    124         ; Source of Notification and Date/Time last entered.
    125         ;
    126         I '$D(DGNOW) S DGNOW=$$HTFM^XLFDT($H)
    127         I $G(DGDAUTO)'=1 S FDA(2,DFN_",",.354)=DGNOW
    128         S FDA(2,DFN_",",.355)=DUZ
    129         D FILE^DIE(,"FDA",)
    130         Q
    131 APTT3   ;Check to exclude "While an Inpatient" from DOD Bulletin
    132         ; Input:  DFN  Output: DGDONOT
    133         N DATE,XIEN,TYPE,XDOD,YES
    134         S DGDONOT=0
    135         S XDOD=$P($G(^DPT(DFN,.35)),"^",1) I 'XDOD Q
    136         S XDOD=$P(XDOD,".",1),YES=0,TYPE=""
    137         I '$D(^DGPM("APTT3",DFN)) Q
    138         S DATE=$O(^DGPM("APTT3",DFN,XDOD)) I 'DATE Q
    139         I $P(DATE,".",1)=XDOD S YES=1
    140         I ($P(DATE,".",1)-1)=XDOD S YES=1
    141         S XIEN=$O(^DGPM("APTT3",DFN,DATE,"")) I 'XIEN Q
    142         S TYPE=$P($G(^DGPM(XIEN,0)),"^",4)
    143         I YES,'((TYPE=27)!(TYPE=32)) S DGDONOT=1
    144         Q
    145 SNDISP  ; Source of Notification display choices
    146         N DIR,DTOUT,DUOUT,DIRUT,DIROUT,DGLIST,DGLNAME,I,X,Y
    147         S DGLIST=$P($G(^DD(2,.353,0)),"^",3)
    148         S Y=6
    149         S DIR("?",1)=" "
    150         S DIR("?",2)=" This is a required response. Please select from the following:"
    151         S DIR("?",3)=" Entering '^' will take you back to the Source of Notification prompt"
    152         S DIR("?",4)=" "
    153         S DIR("?",5)=" "
    154         F X=1:1 S DGLNAME=$P(DGLIST,";",X) Q:DGLNAME']""  S DIR("?",Y)="      "_$P(DGLNAME,":",1)_"      "_$P(DGLNAME,":",2) S Y=Y+1
    155         S DIR("?",Y)=" "
    156         F I=1:1 Q:'$D(DIR("?",I))  W !,DIR("?",I)
    157         Q
     1DGDEATH ;ALB/MRL/PJR-PROCESS DECEASED PATIENTS ; 10/27/04 9:45pm
     2 ;;5.3;Registration;**45,84,101,149,392,545,595,568,563,725**;Aug 13, 1993;Build 12
     3 ;
     4GET N DGMTI,DATA
     5 S DGDTHEN="" W !! S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G Q:Y'>0 S (DA,DFN)=+Y
     6 S DGDOLD=$G(^DPT(DFN,.35))
     7 I $D(^DPT(DFN,.1)) W !?3,"Patient is currently in-house.  Discharge him with a discharge type of DEATH." G GET
     8 I $S($D(^DPT(DFN,.35)):^(.35),1:"") F DGY=0:0 S DGY=$O(^DGPM("ATID1",DFN,DGY)) Q:'DGY  S DGDA=$O(^(DGY,0)) I $D(^DGPM(+DGDA,0)),$P(^(0),"^",17)]"" S DGXX=$P(^(0),"^",17),DGXX=^DGPM(DGXX,0) I "^12^38^"[("^"_$P(DGXX,"^",18)_"^") G DIS
     9 D NOW^%DTC S DGNOW=%
     10 S ^TMP("DEATH",$J)=1
     11 K A W ! S DIE=DIC,DR=".351" D ^DIE
     12 I '$D(^DPT(DFN,.35)) K ^TMP("DEATH",$J) G GET
     13 S DGDNEW=^DPT(DFN,.35)
     14 I $P(DGDNEW,"^",1)="",$P(DGDNEW,"^",2)'="" S DR=".352////@" D ^DIE
     15 I $P(DGDNEW,"^",1)="" K ^TMP("DEATH",$J) G GET
     16 I $P(DGDNEW,"^",1)'="" S DR=".353" D ^DIE
     17 I DGDOLD'=DGDNEW D DISCHRGE
     18 I $P(DGDOLD,"^",1)'=$P(DGDNEW,"^",1) D XFR
     19 K ^TMP("DEATH",$J) G GET
     20 ;
     21DIS W !,"Patient has a discharge type of Death",!,"Edit the discharge",!
     22Q K A,DA,DFN,DGDA,DIC,DIE,DR,DGXX,DGY,DGDTHEN,DGDOLD,DGDNEW,DGDONOT Q
     23XFR ; called from set x-ref of field .351 of file 2
     24 N DGPCMM,DGFAPT,DGFAPTI,DGFAPT1
     25 Q:'$D(DFN)
     26 K DGTEXT D ^DGPATV S DGDEATH=$$GET1^DIQ(2,DFN,.351,"I"),XMSUB="PATIENT HAS EXPIRED",DGCT=0
     27 D DEMOG
     28 S DGT=X-.0001,(Y,DGDDT)=X,DG1="" D:DGT]"" ^DGPMSTAT
     29 S Y=$$FMTE^XLFDT(Y),Y=$S(Y]"":Y,1:"UNKNOWN")
     30 S DGDONOT=0 D APTT3
     31 D LINE("")
     32 D LINE("      Date/Time of Death: "_DEATHVAL_$S(DGDONOT:"",'DG1:"",$D(DGDTHEN):"",1:"  (While an inpatient)"))
     33 D LINE("")
     34 I '$D(ADM),DG1,$D(^DGPM(+DGA1,0)) S ADM=+^DGPM($P(^(0),"^",14),0)
     35 S Y=$$FMTE^XLFDT($S($D(ADM):ADM,1:""))
     36 D LINE($S($D(DGDTHEN):"",DG1:"     Admission Date/Time: "_Y_$S((DGDDT-ADM)<1:"  (Within 24 hours of hospitalization)",1:""),1:""))
     37 D LINE("")
     38 S DGX=$P($G(^DGPM(+$G(DGA1),0)),"^",6),DGX=$P($G(^DIC(42,+DGX,0)),U,1)
     39 D LINE($S($D(DGDTHEN):"",('DG1):"",$D(DGA1):"             Admitted To: "_$S(DGX]"":DGX,1:"UNKNOWN"),1:"")) K DGX
     40 D LINE("")
     41 I DG1&'$D(DGDTHEN) D
     42 . D LINE($S($D(DGXFR0):"           Last Transfer: "_$S($D(^DIC(42,+$P(DGXFR0,"^",6),0)):$P(^(0),"^"),1:"UNKNOWN"),1:""))
     43 . D LINE("")
     44F N DGARRAY,SDCNT S DGFAPT=DGDEATH,DGFAPTI=""
     45 S DGARRAY("FLDS")=3,DGARRAY(4)=DFN,DGARRAY("SORT")="P",DGARRAY(1)=DT,DGARRAY(3)="I;R"
     46 S SDCNT=$$SDAPI^SDAMA301(.DGARRAY)
     47 ;
     48 I SDCNT>0 F  S DGFAPT=$O(^TMP($J,"SDAMA301",DFN,DGFAPT)) Q:'DGFAPT  S DGFAPT1=$G(^TMP($J,"SDAMA301",DFN,DGFAPT)) Q:DGFAPT1']""  D  Q:DGFAPTI
     49 .I $P($P(DGFAPT1,U,3),";")'["C" D LINE("NOTE: Patient has future appointments scheduled!!") S DGFAPTI=1
     50 S DGSCHAD=0 D SA I DGSCHAD D LINE("NOTE: Patient had scheduled admissions which have been cancelled!!")
     51 I 'DGVETS D LINE("Patient is a NON-VETERAN."_$S($D(^DIC(21,+$P($G(^DPT(DFN,.32)),"^",3),0)):"  ["_$P(^(0),"^",1)_"]",1:""))
     52 S DGPCMM=$$PCMMXMY^SCAPMC25(1,DFN,,,0) ;creates xmy array
     53 S DGCT=$$PCMAIL^SCMCMM(DFN,"DGTEXT",DT)
     54Q1 S DGB=1 D ^DGBUL S X=DGDEATH
     55 K DGDEATH,DGSCHAD,DGI,Y,DGDDT,^TMP($J,"SDAMA301") D KILL^DGPATV K ADM,DG1,DGA1,DGCT,DGT,DGXX,DGY,Z Q
     56SA F DGI=0:0 S DGI=$O(^DGS(41.1,"B",DFN,DGI)) Q:'DGI  I $D(^DGS(41.1,DGI,0)),($P(^(0),"^",13)']""),($P(^(0),"^",17)']"") S $P(^(0),"^",13)=DGDEATH,$P(^(0),"^",14)=+DUZ,$P(^(0),"^",15)=1,$P(^(0),"^",16)=2,DGSCHAD=1
     57 Q
     58 ;
     59DEL ; delete death bulletin
     60 N DGPCMM,DELBY,DELTM,DTHINFO
     61 S DFN=+$G(DA) I '$D(^DPT(DFN,0)) Q  ; no patient node
     62 I +$G(^DPT(DFN,.35)) Q  ; not deletion
     63 S DGDEATH=X,XMSUB="Patient Death has been Deleted",DGCT=0
     64 D ^DGPATV
     65 D LINE("The date of death for the following patient has been deleted.")
     66 D LINE("")
     67 D DEMOG
     68 D LINE("")
     69 S DGPCMM=$$PCMMXMY^SCAPMC25(1,DFN,,,0) ;creates xmy array
     70 S DGCT=$$PCMAIL^SCMCMM(DFN,"DGTEXT",DT)
     71 S DGB=1 D ^DGBUL S X=DGDEATH
     72 K DGCT,DGDEATH D KILL^DGPATV
     73 Q
     74 ;
     75DEMOG ; list main demographics
     76 D LINE("                    NAME: "_DGNAME)
     77 D LINE("                     SSN: "_$P(SSN,"^",2))
     78 D LINE("                     DOB: "_$P(DOB,"^",2))
     79 I DGVETS D
     80 . N DGX
     81 . S DGX=$G(^DPT(DFN,.31))
     82 . S DGLOCATN=$$FIND1^DIC(4,"","MX","`"_+$P(DGX,U,4)),DGLOCATN=$S(+DGLOCATN>0:$P($$NS^XUAF4(DGLOCATN),U),1:"NOT LISTED")
     83 . D LINE("   CLAIM FOLDER LOCATION: "_$S($D(DGLOCATN):DGLOCATN,1:"NOT LISTED"))
     84 . D LINE("            CLAIM NUMBER: "_$S($P(DGX,"^",3)]"":$P(DGX,"^",3),1:"NOT LISTED"))
     85 D LINE("   COORDINATING MASTER OF RECORD: "_DGCMOR)
     86 D GETS^DIQ(2,DFN_",",".351;.353;.354;.355","E","DTHINFO")
     87 S DEATHVAL=$G(DTHINFO(2,DFN_",",.351,"E"))
     88 S DEATHVAL=$$FMTE^XLFDT(DEATHVAL),DEATHVAL=$S(DEATHVAL]"":DEATHVAL,1:"UNKNOWN")
     89 S SOURCE=$G(DTHINFO(2,DFN_",",.353,"E"))
     90 S DELTM=$G(DTHINFO(2,DFN_",",.354,"E"))
     91 S DELBY=$G(DTHINFO(2,DFN_",",.355,"E"))
     92 D LINE("")
     93 D LINE("             LAST EDITED BY: "_DELBY)
     94 D LINE("    DATE/TIME LAST MODIFIED: "_DELTM)
     95 D LINE("     SOURCE OF NOTIFICATION: "_$S(SOURCE="":"UNDEFINED",1:SOURCE))
     96 ;K DEATHVAL,SOURCE,DELTM,DELBY
     97 Q
     98 ;
     99LINE(X) ; add line contained in X to array
     100 S DGCT=DGCT+1
     101 S DGTEXT(DGCT,0)=X
     102 Q
     103DSBULL ;
     104 ;
     105 I $G(IVMDODUP)=1 Q
     106 S DFN=DA
     107 I $D(DGPMDA) D  Q
     108 .S DISTYPE=$P($G(^DGPM(DGPMDA,0)),"^",18)
     109 .I $G(^DG(405.2,DISTYPE,0))["DEATH" D
     110 ..S FDA(2,DFN_",",.353)=1 D FILE^DIE(,"FDA","BWFERR")
     111 ..D DISCHRGE,XFR
     112 I $D(^TMP("DEATH",$J)) Q
     113 D DISCHRGE,XFR
     114 Q
     115DKBULL ;
     116 S DFN=DA
     117 S FDA(2,DFN_",",.353)="@"
     118 I $D(^TMP("DEATH",$J)) S FDA(2,DFN_",",.355)=DUZ
     119 D FILE^DIE(,"FDA",)
     120 D DEL
     121 Q
     122DISCHRGE ;
     123 ; If the patient is being discharged, determine values needed for
     124 ; Source of Notification and Date/Time last entered.
     125 ;
     126 I '$D(DGNOW) S DGNOW=$$HTFM^XLFDT($H)
     127 I $G(DGDAUTO)'=1 S FDA(2,DFN_",",.354)=DGNOW
     128 S FDA(2,DFN_",",.355)=DUZ
     129 D FILE^DIE(,"FDA",)
     130 Q
     131APTT3 ;Check to exclude "While an Inpatient" from DOD Bulletin
     132 ; Input:  DFN  Output: DGDONOT
     133 N DATE,XIEN,TYPE,XDOD,YES
     134 S DGDONOT=0
     135 S XDOD=$P($G(^DPT(DFN,.35)),"^",1) I 'XDOD Q
     136 S XDOD=$P(XDOD,".",1),YES=0,TYPE=""
     137 I '$D(^DGPM("APTT3",DFN)) Q
     138 S DATE=$O(^DGPM("APTT3",DFN,XDOD)) I 'DATE Q
     139 I $P(DATE,".",1)=XDOD S YES=1
     140 I ($P(DATE,".",1)-1)=XDOD S YES=1
     141 S XIEN=$O(^DGPM("APTT3",DFN,DATE,"")) I 'XIEN Q
     142 S TYPE=$P($G(^DGPM(XIEN,0)),"^",4)
     143 I YES,'((TYPE=27)!(TYPE=32)) S DGDONOT=1
     144 Q
Note: See TracChangeset for help on using the changeset viewer.