AZAXDPM1 ;IHS/PHXAO/AEF - FIND IHS PATIENT FILE POINTERS FOR PATIENT MERGE PROCESS
;;1.0;ANNE'S SPECIAL ROUTINES;;AUG 23, 2004
;;
;;THIS ROUTINE SEARCHES EACH POINTER TO THE IHS PATIENT FILE
;;FOR THE SPECIFIED POINTER VALUE
;;
EN ;EP -- MAIN ENTRY POINT
;
N DFN,Y
;
D ^XBKVAR
D HOME^%ZIS
;
D SEL(.Y)
Q:Y'>0
S DFN=+Y
;
D DO(DFN)
Q
SEL(DFN) ;
;----- SELECT DFN TO SEARCH FOR
;
N DIR,X
S DIR(0)="N"
S DIR("A")="Select DFN to search for"
D ^DIR
Q +Y
DO(DFN) ;
;----- PROCESS POINTERS
;
D QUE(DFN)
Q
DQ ;EP -- QUEUED JOB STARTS HERE
;
D PRT(DFN)
D ^%ZISC
Q
PRT(DFN) ;
;----- PRINT THE REPORT
;
N CNT,D0,D1,D2,DUZ2,I,ROU,X
W @IOF
W !,"FINDING IHS 'PATIENT' FILE POINTERS FOR PATIENT ",$P($G(^DPT(DFN,0)),U)," DFN #",DFN,!
S CNT=0
F I=1:1:208 D
. S ROU="I"_I_"("_DFN_","_I_","_".CNT"_")"
. D @ROU
;
W !!,CNT," POINTERS FOUND",!
Q
I1(DFN,I,CNT) ;
;----- NAME field (#.01) of the USER MENU File (#112.6)
;
D HDR("I1",I)
S D0=0
F S D0=$O(^FHUM(D0)) Q:'D0 D
. S X=$P(^FHUM(D0,0),U)
. Q:+X'=DFN
. Q:"^DFN(^AUPNPAT("'[$P(X,";",2)
. D WRITE(D0,DFN,.CNT)
Q
I2(DFN,I,CNT) ;
;----- PATIENT NAME field (#.01) of the NCI CANCER REGISTER PATIENT FILE File (#19259.02)
;
D HDR("I2",I)
S D0=DFN ;DINUMED
Q:'$D(^CIMSCPAT(D0))
D WRITE(D0,DFN,.CNT)
Q
I3(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the VEN EHP AUDIT TRAIL File (#19707.8)
;
D HDR("I3",I)
S D0=0
F S D0=$O(^VEN(7.8,D0)) Q:'D0 D
. Q:$P($G(^VEN(7.8,D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I4(DFN,I,CNT) ;
;----- PATIENT field (#.03) of the RCIS REFERRAL File (#90001)
;
D HDR("I4",I)
S D0=0
F S D0=$O(^BMCREF(D0)) Q:'D0 D
. Q:$P($G(^BMCREF(D0,0)),U,3)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I5(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the RCIS DIAGNOSIS File (#90001.01)
;
D HDR("I5",I)
S D0=0
F S D0=$O(^BMCDX(D0)) Q:'D0 D
. Q:$P($G(^BMCDX(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I6(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the RCIS PROCEDURE File (#90001.02)
;
D HDR("I6",I)
S D0=0
F S D0=$O(^BMCPX(D0)) Q:'D0 D
. Q:$P($G(^BMCPX(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I7(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the RCIS CASE REVIEW COMMENTS File (#90001.03)
;
D HDR("I7",I)
S D0=0
F S D0=$O(^BMCCOM(D0)) Q:'D0 D
. Q:$P($G(^BMCCOM(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I8(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the RCIS SECONDARY PROVIDER LETTER File (#90001.04)
;
D HDR("I8",I)
S D0=0
F S D0=$O(^BMCPROV(D0)) Q:'D0 D
. Q:$P($G(^BMCPROV(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I9(DFN,I,CNT) ;
;----- PATIENT field (#.04) of the CHR RECORD File (#90002)
;
D HDR("I9",I)
S D0=0
F S D0=$O(^BCHR(D0)) Q:'D0 D
. Q:$P($G(^BCHR(D0,0)),U,4)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I10(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the CHR POV File (#90002.01)
;
D HDR("I10",I)
S D0=0
F S D0=$O(^BCHRPROB(D0)) Q:'D0 D
. Q:$P($G(^BCHRPROB(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I11(DFN,I,CNT) ;
;----- PATIENT field (#101) of the A/R BILL/IHS File (#90050.01)
;
D HDR("I11",I)
S DUZ2=0
F S DUZ2=$O(^BARBL(DUZ2)) Q:'DUZ2 D
. S D0=0
. F S D0=$O(^BARBL(DUZ2,D0)) Q:'D0 D
. . Q:$P($G(^BARBL(DUZ2,D0,1)),U)'=DFN
. . W !?5,DUZ2,?15,D0,?25,DFN
. . S CNT=$G(CNT)+1
Q
I12(DFN,I,CNT) ;
;----- ACCOUNT field (#.01) of the A/R ACCOUNTS/IHS File (#90050.02)
;
D HDR("I12",I)
S DUZ2=0
F S DUZ2=$O(^BARAC(DUZ2)) Q:'DUZ2 D
. S D0=0
. F S D0=$O(^BARAC(DUZ2,D0)) Q:'D0 D
. . S X=$P($G(^BARAC(DUZ2,D0,0)),U)
. . Q:+X'=DFN
. . Q:"^DFN(^AUPNPAT("'[$P(X,";",2)
. . W !?5,DUZ2,?15,D0,?25,DFN
. . S CNT=$G(CNT)+1
Q
I13(DFN,I,CNT) ;
;----- PATIENT field (#.01) of the PATIENT sub-field (#90050.0211) of the A/R ACCOUNTS/IHS File (#90050.02)
;
D HDR("I13",I)
S DUZ2=0
F S DUZ2=$O(^BARAC(DUZ2)) Q:'DUZ2 D
. S D0=0
. F S D0=$O(^BARAC(DUZ2,D0)) Q:'D0 D
. . S D1=0
. . F S D1=$O(^BARAC(DUZ2,D0,11,D1)) Q:'D1 D
. . . Q:$P($G(^BARAC(DUZ2,D0,11,D1,0)),U)'=DFN
. . . W !?5,DUZ2,?15,D0,?25,D1,?35,DFN
. . . S CNT=$G(CNT)+1
Q
I14(DFN,I,CNT) ;
;----- PATIENT (A/R) field (#5) of the A/R TRANSACTIONS/IHS File (#90050.03)
;
D HDR("I14",I)
S DUZ2=0
F S DUZ2=$O(^BARTR(DUZ2)) Q:'DUZ2 D
. S D0=0
. F S D0=$O(^BARTR(DUZ2,D0)) Q:'D0 D
. . Q:$P($G(^BARTR(DUZ2,D0,0)),U,5)'=DFN
. . W !?5,DUZ2,?15,D0,?25,DFN
. . S CNT=$G(CNT)+1
Q
I15(DFN,I,CNT) ;
;----- PATIENT field (#5) of the ITEM(S) sub-field (#90051.1101) of the A/R COLLECTION BATCH/IHS File (#90051.01)
;
D HDR("I15",I)
S DUZ2=0
F S DUZ2=$O(^BARCOL(DUZ2)) Q:'DUZ2 D
. S D0=0
. F S D0=$O(^BARCOL(DUZ2,D0)) Q:'D0 D
. . S D1=0
. . F S D1=$O(^BARCOL(DUZ2,D0,1,D1)) Q:'D1 D
. . . Q:$P($G(^BARCOL(DUZ2,D0,1,D1,0)),U,6)'=DFN
. . . W !?5,DUZ2,?15,D0,?25,D1,?35,DFN
. . . S CNT=$G(CNT)+1
Q
I16(DFN,I,CNT) ;
;----- A/R PATIENT field (#.12) of the A/R EDI 835 HOLDING File (#90056.07)
;
D HDR("I16",I)
S D0=0
F S D0=$O(^BAR835(D0)) Q:'D0 D
. Q:$P($G(^BAR835(D0,1)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I17(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the BPC ORDERABLES File (#90080)
;
D HDR("I17",I)
S D0=0
F S D0=$O(^BPCORD(D0)) Q:'D0 D
. Q:$P($G(^BPCORD(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I18(DFN,I,CNT) ;
;----- PATIENT field (#.01) of the ASTHMA REGISTER File (#90181.01)
;
D HDR("I18",I)
S D0=DFN ;DINUMED
Q:'$D(^BATREG(D0))
D WRITE(D0,DFN,.CNT)
Q
I19(DFN,I,CNT) ;
;----- PATIENT field (#.03) of the ROI LISTING RECORD File (#90264)
;
D HDR("I19",I)
S D0=0
F S D0=$O(^BRNREC(D0)) Q:'D0 D
. Q:$P($G(^BRNREC(D0,0)),U,3)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I20(DFN,I,CNT) ;
;----- PATIENT field (#.03) of the BZD PYXIS REGISTRATION LOG File (#1410004)
;
D HDR("I20",I)
S D0=0
F S D0=$O(^BZDPLOG(D0)) Q:'D0 D
. Q:$P($G(^BZDPLOG(D0,0)),U,3)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I21(DFN,I,CNT) ;
;----- Patient Pointer field (#.12) of the BZD PYXIS BILLS File (#1410005)
;
D HDR("I21",I)
S D0=0
F S D0=$O(^BZDPBILL(D0)) Q:'D0 D
. Q:$P($G(^BZDPBILL(D0,0)),U,12)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I22(DFN,I,CNT) ;
;----- PATIENT field (#.03) of the ROI DISCLOSURE File (#1991075)
;
D HDR("I22",I)
S D0=0
F S D0=$O(^AZXAREC(D0)) Q:'D0 D
. Q:$P($G(^AZXAREC(D0,0)),U,3)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I23(DFN,I,CNT) ;
;----- NAME field (#.01) of the SUICIDE File (#8000000)
;
D HDR("I23",I)
S D0=0
F S D0=$O(^DIZ(8000000,D0)) Q:'D0 D
. Q:$P($G(^DIZ(8000000,D0,0)),U)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I24(DFN,I,CNT) ;
;----- NAME field (#.01) of the PRENATAL REGISTER File (#8000001)
;
D HDR("I24",I)
S D0=0
F S D0=$O(^DIZ(8000001,D0)) Q:'D0 D
. Q:$P($G(^DIZ(8000001,D0,0)),U)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I25(DFN,I,CNT) ;
;----- NAME field (#.01) of the EYE CLINIC RECALL File (#8000008)
;
D HDR("I25",I)
S D0=0
F S D0=$O(^DIZ(8000008,D0)) Q:'D0 D
. Q:$P($G(^DIZ(8000008,D0,0)),U)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I26(DFN,I,CNT) ;
;----- NAME field (#.01) of the PHN IMM File (#8000014)
;
D HDR("I26",I)
S D0=0
F S D0=$O(^DIZ(8000014,D0)) Q:'D0 D
. Q:$P($G(^DIZ(8000014,D0,0)),U)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I27(DFN,I,CNT) ;
;----- NAME field (#.01) of the DIABETIC PATIENTS File (#8000016)
;
D HDR("I27",I)
S D0=0
F S D0=$O(^DIZ(8000016,D0)) Q:'D0 D
. Q:$P($G(^DIZ(8000016,D0,0)),U)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I28(DFN,I,CNT) ;
;----- PATIENT field (#.01) of the AZHQ 3P CLAIM DATA File (#8008604.3)
;
D HDR("I28",I)
S DUZ2=0
F S DUZ2=$O(^AZHQCLM(DUZ2)) Q:'DUZ2 D
. S D0=0
. F S D0=$O(^AZHQCLM(DUZ2,D0)) Q:'D0 D
. . Q:$P($G(^AZHQCLM(DUZ2,D0,0)),U)'=DFN
. . W !?5,DUZ2,?15,D0,?25,DFN
. . S CNT=$G(CNT)+1
Q
I29(DFN,I,CNT) ;
;----- REGISTERED PATIENT field (#4.1) of the AZHQ CHS DENIAL DATA File (#8008607)
;
D HDR("I29",I)
S D0=0
F S D0=$O(^AZHQDEN(D0)) Q:'D0 D
. Q:$P($G(^AZHQDEN(D0,0)),U,5)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I30(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the AZHQ PROBLEM File (#8008611)
;
D HDR("I30",I)
S D0=0
F S D0=$O(^AZHQPROB(D0)) Q:'D0 D
. Q:$P($G(^AZHQPROB(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I31(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the AZHQ PERSONAL HISTORY File (#8008613)
;
D HDR("I31",I)
S D0=0
F S D0=$O(^AZHQPH(D0)) Q:'D0 D
. Q:$P($G(^AZHQPH(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I32(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the AZHQ FAMILY HISTORY File (#8008614)
;
D HDR("I32",I)
S D0=0
F S D0=$O(^AZHQFH(D0)) Q:'D0 D
. Q:$P($G(^AZHQFH(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I33(DFN,I,CNT) ;
;----- PATIENT field (#.03) of the AZHQ QI OCC DIAGNOSIS File (#8008666.8)
;
D HDR("I33",I)
S D0=0
F S D0=$O(^AZHQOCC(8,D0)) Q:'D0 D
. Q:$P($G(^AZHQOCC(8,D0,0)),U,3)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I34(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the File (#8008670.07)
;
D HDR("I34",I)
W !?5,"<FILE CORRUPTED!>"
Q
I35(DFN,I,CNT) ;
;----- PATIENT field (#.05) of the AZHQ 3P BILL File (#8008674.4)
;
D HDR("I35",I)
S DUZ2=0
F S DUZ2=$O(^AZHQBILL(DUZ2)) Q:'DUZ2 D
. S D0=0
. F S D0=$O(^AZHQBILL(DUZ2,D0)) Q:'D0 D
. . Q:$P($G(^AZHQBILL(DUZ2,D0,0)),U,5)'=DFN
. . W !?5,DUZ2,?15,D0,?25,DFN
. . S CNT=$G(CNT)+1
Q
I36(DFN,I,CNT) ;
;----- PATIENT NAME field (#.05) of the AZHQ VISIT File (#8008675)
;
D HDR("I36",I)
S D0=0
F S D0=$O(^AZHQVSIT(D0)) Q:'D0 D
. Q:$P($G(^AZHQVSIT(D0,0)),U,5)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I37(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the AZHQ V HOSPITALIZATION File (#8008675.02)
;
D HDR("I37",I)
S D0=0
F S D0=$O(^AZHQVINP(D0)) Q:'D0 D
. Q:$P($G(^AZHQVINP(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I38(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the AZHQ V POV File (#8008675.07)
;
D HDR("I38",I)
S D0=0
F S D0=$O(^AZHQVPOV(D0)) Q:'D0 D
. Q:$P($G(^AZHQVPOV(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I39(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the AZHQ V PROCEDURE File (#8008675.08)
;
D HDR("I39",I)
S D0=0
F S D0=$O(^AZHQVPRC(D0)) Q:'D0 D
. Q:$P($G(^AZHQVPRC(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I40(DFN,I,CNT) ;
;----- PATIENT field (#13.64) of the DOCUMENT sub-field (#8008680.01) of the AZHQ CHS FACILITY File (#8008680)
;
D HDR("I40",I)
S D0=0
F S D0=$O(^AZHQF(D0)) Q:'D0 D
. S D1=0
. F S D1=$O(^AZHQF(D0,"D",D1)) Q:'D1 D
. . Q:$P($G(^AZHQF(D0,"D",D1,0)),U,22)'=DFN
. . W !?5,D0,?15,D1,?25,DFN
. . S CNT=$G(CNT)+1
Q
I41(DFN,I,CNT) ;
;----- PATIENT field (#2) of the TRANSACTION RECORD sub-field (#8008680.02) of the DOCUMENT sub-field (#8008680.01) of the AZHQ CHS FACILITY File (#8008680)
;
D HDR("I41",I)
S D0=0
F S D0=$O(^AZHQF(D0)) Q:'D0 D
. S D1=0
. F S D1=$O(^AZHQF(D0,"D",D1)) Q:'D1 D
. . S D2=0
. . F S D2=$O(^AZHQF(D0,"D",D1,"T",D2)) Q:'D2 D
. . . Q:$P($G(^AZHQF(D0,"D",D1,"T",D2,0)),U,3)'=DFN
. . . W !?5,D0,?15,D1,?25,D2,?35,DFN
. . . S CNT=$G(CNT)+1
Q
I42(DFN,I,CNT) ;
;----- PATIENT NAME field (#.01) of the *PRENATAL File (#9000002)
;
D HDR("I42",I)
S D0=DFN ;DINUMED
Q:'$D(^AUPNPNTL(D0))
D WRITE(D0,DFN,.CNT)
Q
I43(DFN,I,CNT) ;
;----- PATIENT NAME field (#.01) of the MEDICARE ELIGIBLE File (#9000003)
;
D HDR("I43",I)
S D0=DFN ;DINUMED
Q:'$D(^AUPNMCR(D0))
D WRITE(D0,DFN,.CNT)
Q
I44(DFN,I,CNT) ;
;----- PATIENT POINTER field (#.02) of the POLICY HOLDER File (#9000003.1)
;
D HDR("I44",I)
S D0=0
F S D0=$O(^AUPN3PPH(D0)) Q:'D0 D
. Q:$P($G(^AUPN3PPH(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I45(DFN,I,CNT) ;
;----- PATIENT NAME field (#.01) of the MEDICAID ELIGIBLE File (#9000004)
;
D HDR("I45",I)
S D0=0
F S D0=$O(^AUPNMCD(D0)) Q:'D0 D
. Q:$P($G(^AUPNMCD(D0,0)),U)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I46(DFN,I,CNT) ;
;----- PATIENT NAME field (#.01) of the RAILROAD ELIGIBLE File (#9000005)
;
D HDR("I46",I)
S D0=DFN ;DINUMED
Q:'$D(^AUPNRRE(D0))
D WRITE(D0,DFN,.CNT)
Q
I47(DFN,I,CNT) ;
;----- PATIENT NAME field (#.01) of the PRIVATE INSURANCE ELIGIBLE File (#9000006)
;
D HDR("I47",I)
S D0=DFN ;DINUMED
Q:'$D(^AUPNPRVT(D0))
D WRITE(D0,DFN,.CNT)
Q
I48(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the *SCHEDULED ENCOUNTER File (#9000007)
;
D HDR("I48",I)
S D0=0
F S D0=$O(^AUPNFSE(D0)) Q:'D0 D
. Q:$P($G(^AUPNFSE(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I49(DFN,I,CNT) ;
;----- PATIENT NAME field (#.01) of the *SURVEILLANCE File (#9000008)
;
D HDR("I49",I)
S D0=0
F S D0=$O(^AUPNSURV(D0)) Q:'D0 D
. Q:$P($G(^AUPNSURV(D0,0)),U)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I50(DFN,I,CNT) ;
;----- PATIENT NAME field (#.01) of the *CLINICAL REMINDER File (#9000009)
;
D HDR("I50",I)
S D0=0
F S D0=$O(^AUPNCR(D0)) Q:'D0 D
. Q:$P($G(^AUPNCR(D0,0)),U)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I51(DFN,I,CNT) ;
;----- PATIENT NAME field (#.05) of the VISIT File (#9000010)
;
D HDR("I51",I)
S D0=0
F S D0=$O(^AUPNVSIT(D0)) Q:'D0 D
. Q:$P($G(^AUPNVSIT(D0,0)),U,5)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I52(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V MEASUREMENT File (#9000010.01)
;
D HDR("I52",I)
S D0=0
F S D0=$O(^AUPNVMSR(D0)) Q:'D0 D
. Q:$P($G(^AUPNVMSR(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I53(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V HOSPITALIZATION File (#9000010.02)
;
D HDR("I53",I)
S D0=0
F S D0=$O(^AUPNVINP(D0)) Q:'D0 D
. Q:$P($G(^AUPNVINP(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I54(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V CHS File (#9000010.03)
;
D HDR("I54",I)
S D0=0
F S D0=$O(^AUPNVCHS(D0)) Q:'D0 D
. Q:$P($G(^AUPNVCHS(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I55(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V EYE GLASS File (#9000010.04)
;
D HDR("I55",I)
S D0=0
F S D0=$O(^AUPNVEYE(D0)) Q:'D0 D
. Q:$P($G(^AUPNVEYE(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I56(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V DENTAL File (#9000010.05)
;
D HDR("I56",I)
S D0=0
F S D0=$O(^AUPNVDEN(D0)) Q:'D0 D
. Q:$P($G(^AUPNVDEN(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I57(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V PROVIDER File (#9000010.06)
;
D HDR("I57",I)
S D0=0
F S D0=$O(^AUPNVPRV(D0)) Q:'D0 D
. Q:$P($G(^AUPNVPRV(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I58(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V POV File (#9000010.07)
;
D HDR("I58",I)
S D0=0
F S D0=$O(^AUPNVPOV(D0)) Q:'D0 D
. Q:$P($G(^AUPNVPOV(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I59(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V PROCEDURE File (#9000010.08)
;
D HDR("I59",I)
S D0=0
F S D0=$O(^AUPNVPRC(D0)) Q:'D0 D
. Q:$P($G(^AUPNVPRC(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I60(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V LAB File (#9000010.09)
;
D HDR("I60",I)
S D0=0
F S D0=$O(^AUPNVLAB(D0)) Q:'D0 D
. Q:$P($G(^AUPNVLAB(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I61(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V IMMUNIZATION File (#9000010.11)
;
D HDR("I61",I)
S D0=0
F S D0=$O(^AUPNVIMM(D0)) Q:'D0 D
. Q:$P($G(^AUPNVIMM(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I62(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V SKIN TEST File (#9000010.12)
;
D HDR("I62",I)
S D0=0
F S D0=$O(^AUPNVSK(D0)) Q:'D0 D
. Q:$P($G(^AUPNVSK(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I63(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V EXAM File (#9000010.13)
;
D HDR("I63",I)
S D0=0
F S D0=$O(^AUPNVXAM(D0)) Q:'D0 D
. Q:$P($G(^AUPNVXAM(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I64(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V MEDICATION File (#9000010.14)
;
D HDR("I64",I)
S D0=0
F S D0=$O(^AUPNVMED(D0)) Q:'D0 D
. Q:$P($G(^AUPNVMED(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I65(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V TREATMENT File (#9000010.15)
;
D HDR("I65",I)
S D0=0
F S D0=$O(^AUPNVTRT(D0)) Q:'D0 D
. Q:$P($G(^AUPNVTRT(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I66(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V PATIENT ED File (#9000010.16)
;
D HDR("I66",I)
S D0=0
F S D0=$O(^AUPNVPED(D0)) Q:'D0 D
. Q:$P($G(^AUPNVPED(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I67(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V PHYSICAL THERAPY File (#9000010.17)
;
D HDR("I67",I)
S D0=0
F S D0=$O(^AUPNVPT(D0)) Q:'D0 D
. Q:$P($G(^AUPNVPT(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I68(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V CPT File (#9000010.18)
;
D HDR("I68",I)
S D0=0
F S D0=$O(^AUPNVCPT(D0)) Q:'D0 D
. Q:$P($G(^AUPNVCPT(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I69(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V ACTIVITY TIME File (#9000010.19)
;
D HDR("I69",I)
S D0=0
F S D0=$O(^AUPNVTM(D0)) Q:'D0 D
. Q:$P($G(^AUPNVTM(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I70(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V DIAGNOSTIC PROCEDURE RESULT File (#9000010.21)
;
D HDR("I70",I)
S D0=0
F S D0=$O(^AUPNVDXP(D0)) Q:'D0 D
. Q:$P($G(^AUPNVDXP(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I71(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V RADIOLOGY File (#9000010.22)
;
D HDR("I71",I)
S D0=0
F S D0=$O(^AUPNVRAD(D0)) Q:'D0 D
. Q:$P($G(^AUPNVRAD(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I72(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V HEALTH FACTORS File (#9000010.23)
;
D HDR("I72",I)
S D0=0
F S D0=$O(^AUPNVHF(D0)) Q:'D0 D
. Q:$P($G(^AUPNVHF(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I73(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V PATHOLOGY File (#9000010.24)
;
D HDR("I73",I)
S D0=0
F S D0=$O(^AUPNVPTH(D0)) Q:'D0 D
. Q:$P($G(^AUPNVPTH(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I74(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V MICROBIOLOGY File (#9000010.25)
;
D HDR("I74",I)
S D0=0
F S D0=$O(^AUPNVMIC(D0)) Q:'D0 D
. Q:$P($G(^AUPNVMIC(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I75(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the V NOTE File (#9000010.28)
;
D HDR("I75",I)
S D0=0
F S D0=$O(^AUPNVNOT(D0)) Q:'D0 D
. Q:$P($G(^AUPNVNOT(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I76(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V EMERGENCY VISIT RECORD File (#9000010.29)
;
D HDR("I76",I)
S D0=0
F S D0=$O(^AUPNVER(D0)) Q:'D0 D
. Q:$P($G(^AUPNVER(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I77(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V BLOOD BANK File (#9000010.31)
;
D HDR("I77",I)
S D0=0
F S D0=$O(^AUPNVBB(D0)) Q:'D0 D
. Q:$P($G(^AUPNVBB(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I78(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V PHN File (#9000010.32)
;
D HDR("I78",I)
S D0=0
F S D0=$O(^AUPNVPHN(D0)) Q:'D0 D
. Q:$P($G(^AUPNVPHN(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I79(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V TRANSACTION CODES File (#9000010.33)
;
D HDR("I79",I)
S D0=0
F S D0=$O(^AUPNVTC(D0)) Q:'D0 D
. Q:$P($G(^AUPNVTC(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I80(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V NARRATIVE TEXT File (#9000010.34)
;
D HDR("I80",I)
S D0=0
F S D0=$O(^AUPNVNT(D0)) Q:'D0 D
. Q:$P($G(^AUPNVNT(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I81(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V ELDER CARE File (#9000010.35)
;
D HDR("I81",I)
S D0=0
F S D0=$O(^AUPNVELD(D0)) Q:'D0 D
. Q:$P($G(^AUPNVELD(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I82(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V TRANSACTION CHARGE File (#9000010.37)
;
D HDR("I82",I)
S D0=0
F S D0=$O(^AUPNVTRC(D0)) Q:'D0 D
. Q:$P($G(^AUPNVTRC(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I83(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V UNHF File (#9000010.38)
;
D HDR("I83",I)
S D0=0
F S D0=$O(^AUPNVUNH(D0)) Q:'D0 D
. Q:$P($G(^AUPNVUNH(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I84(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V TREATMENT CONTRACT File (#9000010.39)
;
D HDR("I84",I)
S D0=0
F S D0=$O(^AUPNVTXC(D0)) Q:'D0 D
. Q:$P($G(^AUPNVTXC(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I85(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V ASTHMA File (#9000010.41)
;
D HDR("I85",I)
S D0=0
F S D0=$O(^AUPNVAST(D0)) Q:'D0 D
. Q:$P($G(^AUPNVAST(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I86(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V PODIATRY File (#9000010.42)
;
D HDR("I86",I)
S D0=0
F S D0=$O(^AUPNVPOD(D0)) Q:'D0 D
. Q:$P($G(^AUPNVPOD(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I87(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V VA MOBILE VISIT RELATED File (#9000010.701)
;
D HDR("I87",I)
S D0=0
F S D0=$O(^AUPNVMVR(D0)) Q:'D0 D
. Q:$P($G(^AUPNVMVR(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I88(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V VA MOBILE VISIT TYPES File (#9000010.702)
;
D HDR("I88",I)
S D0=0
F S D0=$O(^AUPNVMVT(D0)) Q:'D0 D
. Q:$P($G(^AUPNVMVT(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I89(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V VA MOBILE PRES ACTIONS File (#9000010.703)
;
D HDR("I89",I)
S D0=0
F S D0=$O(^AUPNVMPA(D0)) Q:'D0 D
. Q:$P($G(^AUPNVMPA(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I90(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V VA MOBILE REFER FOR OUTP File (#9000010.704)
;
D HDR("I90",I)
S D0=0
F S D0=$O(^AUPNVMRO(D0)) Q:'D0 D
. Q:$P($G(^AUPNVMRO(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I91(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V VA MOBILE SPECIALTY OF REFER File (#9000010.705)
;
D HDR("I91",I)
S D0=0
F S D0=$O(^AUPNVMSP(D0)) Q:'D0 D
. Q:$P($G(^AUPNVMSP(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I92(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V VA MOBILE EXAMS ORDERED File (#9000010.706)
;
D HDR("I92",I)
S D0=0
F S D0=$O(^AUPNVMEO(D0)) Q:'D0 D
. Q:$P($G(^AUPNVMEO(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I93(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the V LINE ITEM (GOODS&SERVICES) File (#9000010.99)
;
D HDR("I93",I)
S D0=0
F S D0=$O(^AUPNVLI(D0)) Q:'D0 D
. Q:$P($G(^AUPNVLI(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I94(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the PROBLEM File (#9000011)
;
D HDR("I94",I)
S D0=0
F S D0=$O(^AUPNPROB(D0)) Q:'D0 D
. Q:$P($G(^AUPNPROB(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I95(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the OFFSPRING HISTORY File (#9000012)
;
D HDR("I95",I)
S D0=0
F S D0=$O(^AUPNOFFH(D0)) Q:'D0 D
. Q:$P($G(^AUPNOFFH(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I96(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the PERSONAL HISTORY File (#9000013)
;
D HDR("I96",I)
S D0=0
F S D0=$O(^AUPNPH(D0)) Q:'D0 D
. Q:$P($G(^AUPNPH(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I97(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the FAMILY HISTORY File (#9000014)
;
D HDR("I97",I)
S D0=0
F S D0=$O(^AUPNFH(D0)) Q:'D0 D
. Q:$P($G(^AUPNFH(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I98(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the *UNMET SURGICAL NEED File (#9000015)
;
D HDR("I98",I)
S D0=0
F S D0=$O(^AUPNUMS(D0)) Q:'D0 D
. Q:$P($G(^AUPNUMS(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I99(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the *HISTORY OF PROCEDURES File (#9000016)
;
D HDR("I99",I)
S D0=0
F S D0=$O(^AUPNHOS(D0)) Q:'D0 D
. Q:$P($G(^AUPNHOS(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I100(DFN,I,CNT) ;
;----- NAME field (#.01) of the REPRODUCTIVE FACTORS File (#9000017)
;
D HDR("I100",I)
S D0=DFN ;DINUMED
Q:'$D(^AUPNREP(D0))
D WRITE(D0,DFN,.CNT)
Q
I101(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the HEALTH STATUS File (#9000019)
;
D HDR("I101",I)
S D0=0
F S D0=$O(^AUPNHF(D0)) Q:'D0 D
. Q:$P($G(^AUPNHF(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I102(DFN,I,CNT) ;
;----- NAME field (#.01) of the PT LAB RELATED DATA File (#9000020)
;
D HDR("I102",I)
S D0=DFN ;DINUMED
Q:'$D(^AUPNLABR(D0))
D WRITE(D0,DFN,.CNT)
Q
I103(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the IHS HL7 SUPPLY INTERFACE File (#9000021)
;
D HDR("I103",I)
S D0=0
F S D0=$O(^AUPNSUP(D0)) Q:'D0 D
. Q:$P($G(^AUPNSUP(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I104(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the PATIENT REFUSALS FOR SERVICE/NMI File (#9000022)
;
D HDR("I104",I)
S D0=0
F S D0=$O(^AUPNPREF(D0)) Q:'D0 D
. Q:$P($G(^AUPNPREF(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I105(DFN,I,CNT) ;
;----- PATIENT field (#.01) of the ELDER CARE File (#9000023)
;
D HDR("I105",I)
S D0=DFN ;DINUMED
Q:'$D(^AUPNELDC(D0))
D WRITE(D0,DFN,.CNT)
Q
I106(DFN,I,CNT) ;
;----- PATIENT field (#.01) of the BIRTH MEASUREMENT File (#9000024)
;
D HDR("I106",I)
S D0=DFN ;DINUMED
Q:'$D(^AUPNBMSR(D0))
D WRITE(D0,DFN,.CNT)
Q
I107(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the HEALTH REMINDER OVERRIDE File (#9000025)
;
D HDR("I107",I)
S D0=0
F S D0=$O(^AUPNHMRO(D0)) Q:'D0 D
. Q:$P($G(^AUPNHMRO(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I108(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the INCOME STATUS File (#9000026)
;
D HDR("I108",I)
S D0=0
F S D0=$O(^AUPNINCS(D0)) Q:'D0 D
. Q:$P($G(^AUPNINCS(D0,0)),U,2)='DFN
. D WRITE(D0,DFN,.CNT)
Q
I109(DFN,I,CNT) ;
;----- PATIENT NAME field (#.01) of the OPIOID STATUS File (#9000027)
;
D HDR("I109",I)
S D0=DFN ;DINUMED
Q:'$D(^AUPNOPIU(D0))
D WRITE(D0,DFN,.CNT)
Q
I110(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the AUTO/LIABILITY File (#9000031)
;
D HDR("I110",I)
S D0=0
F S D0=$O(^AUPNAUTO(D0)) Q:'D0 D
. Q:$P($G(^AUPNAUTO(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I111(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the WORKMAN'S COMP File (#9000032)
;
D HDR("I111",I)
S D0=0
F S D0=$O(^AUPNWRKC(D0)) Q:'D0 D
. Q:$P($G(^AUPNWRKC(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I112(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the PATIENT NAME CHANGES File (#9000033)
;
D HDR("I112",I)
S D0=0
F S D0=$O(^AUPNNAMC(D0)) Q:'D0 D
. Q:$P($G(^AUPNNAMC(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I113(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the PATIENT'S LEGAL DOCS File (#9000034)
;
D HDR("I113",I)
S D0=0
F S D0=$O(^AUPNPLDC(D0)) Q:'D0 D
. Q:$P($G(^AUPNPLDC(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I114(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the CATEGORY PRIORITIZING File (#9000035)
;
D HDR("I114",I)
S D0=0
F S D0=$O(^AUPNICP(D0)) Q:'D0 D
. Q:$P($G(^AUPNICP(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I115(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the PRE-CERTIFICATION File (#9000036)
;
D HDR("I115",I)
S D0=0
F S D0=$O(^AUPNPCRT(D0)) Q:'D0 D
. Q:$P($G(^AUPNPCRT(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I116(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the MSP PATIENT File (#9000037)
;
D HDR("I116",I)
S D0=0
F S D0=$O(^AUPNMSP(D0)) Q:'D0 D
. Q:$P($G(^AUPNMSP(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I117(DFN,I,CNT) ;
;----- PATIENT field (#.01) of the NOTICE OF PRIVACY PRACTICES File (#9000038)
;
D HDR("I117",I)
S D0=DFN ;DINUMED
Q:'$D(^AUPNNPP(D0))
D WRITE(D0,DFN,.CNT)
Q
I118(DFN,I,CNT) ;
;----- PATIENT field (#.01) of the RESTRICTED HEALTH INFORMATION File (#9000039)
;
D HDR("I118",I)
S D0=0
F S D0=$O(^AUPNRHI(D0)) Q:'D0 D
. Q:$P($G(^AUPNRHI(D0,0)),U)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I119(DFN,I,CNT) ;
;----- NAME field (#.01) of the PRIMARY CARE PROVIDER CHANGE LOG File (#9000096)
;
D HDR("I119",I)
S D0=0
F S D0=$O(^AUPNPRCL(D0)) Q:'D0 D
. Q:$P($G(^AUPNPRCL(D0,0)),U)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I120(DFN,I,CNT) ;
;----- NAME field (#.01) of the OCCUPATIONAL HEALTH File (#9000097)
;
D HDR("I120",I)
S D0=DFN ;DINUMED
Q:'$D(^AUPNPOCC(D0))
D WRITE(D0,DFN,.CNT)
Q
I121(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the PATIENT EXPOSURES File (#9000098)
;
D HDR("I121",I)
S D0=0
F S D0=$O(^AUPNPEXP(D0)) Q:'D0 D
. Q:$P($G(^AUPNPEXP(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I122(DFN,I,CNT) ;
;----- PATIENT NAME field (#.01) of the PCC DATA ENTRY DM UPDATE File (#9001002.2)
;
D HDR("I122",I)
S D0=0
F S D0=$O(^APCDDMUP(D0)) Q:'D0 D
. Q:$P($G(^APCDDMUP(D0,0)),U)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I123(DFN,I,CNT) ;
;----- PATIENT field (#.01) of the PATIENT sub-field (#9001500.01) of the REGISTER File (#9001500)
;
D HDR("I123",I)
S D0=0
F S D0=$O(^APCRREG(D0)) Q:'D0 D
. S D1=0
. F S D1=$O(^APCRREG(D0,1,D1)) Q:'D1 D
. . Q:$P($G(^APCRREG(D0,1,D1,0)),U)'=DFN
. . W !?5,D0,?15,D1,?25,DFN
. . S CNT=$G(CNT)+1
Q
I124(DFN,I,CNT) ;
;----- NAME field (#.01) of the DENTAL FOLLOWUP File (#9002003.2)
;
D HDR("I124",I)
S D0=0
F S D0=$O(^ADEFOL(D0)) Q:'D0 D
. Q:$P($G(^ADEFOL(D0,0)),U)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I125(DFN,I,CNT) ;
;----- PATIENT NAME field (#.01) of the DENTAL DEFERRED SVCS REGISTER File (#9002003.4)
;
D HDR("I125",I)
S D0=DFN ;DINUMED
Q:'$D(^ADEDSR(D0))
D WRITE(D0,DFN,.CNT)
Q
I126(DFN,I,CNT) ;
;----- NAME field (#.01) of the DENTAL PROCEDURE File (#9002007)
;
D HDR("I126",I)
S D0=0
F S D0=$O(^ADEPCD(D0)) Q:'D0 D
. Q:$P($G(^ADEPCD(D0,0)),U)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I127(DFN,I,CNT) ;
;----- NAME field (#.01) of the DENTAL PATIENT File (#9002010.2)
;
D HDR("I127",I)
S D0=DFN ;DINUMED
Q:'$D(^ADEPAT(D0))
D WRITE(D0,DFN,.CNT)
Q
I128(DFN,I,CNT) ;
;----- PATIENT field (#.08) of the MHSS RECORD File (#9002011)
;
D HDR("I128",I)
S D0=0
F S D0=$O(^AMHREC(D0)) Q:'D0 D
. Q:$P($G(^AMHREC(D0,0)),U,8)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I129(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the MHSS RECORD PROBLEMS (POVS) File (#9002011.01)
;
D HDR("I129",I)
S D0=0
F S D0=$O(^AMHRPRO(D0)) Q:'D0 D
. Q:$P($G(^AMHRPRO(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I130(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the MHSS RECORD PROVIDERS File (#9002011.02)
;
D HDR("I130",I)
S D0=0
F S D0=$O(^AMHRPROV(D0)) Q:'D0 D
. Q:$P($G(^AMHRPROV(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I131(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the MHSS RECORD TREATED MEDICAL PROBS File (#9002011.03)
;
D HDR("I131",I)
S D0=0
F S D0=$O(^AMHRTMDP(D0)) Q:'D0 D
. Q:$P($G(^AMHRTMDP(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I132(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the MHSS RECORD PROCEDURES (CPT) File (#9002011.04)
;
D HDR("I132",I)
S D0=0
F S D0=$O(^AMHRPROC(D0)) Q:'D0 D
. Q:$P($G(^AMHRPROC(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I133(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the MHSS RECORD PATIENT EDUCATION File (#9002011.05)
;
D HDR("I133",I)
S D0=0
F S D0=$O(^AMHREDU(D0)) Q:'D0 D
. Q:$P($G(^AMHREDU(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I134(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the BH CD STAGING TOOL File (#9002011.06)
;
D HDR("I134",I)
S D0=0
F S D0=$O(^AMHRCDST(D0)) Q:'D0 D
. Q:$P($G(^AMHRCDST(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I135(DFN,I,CNT) ;
;----- PATIENT field (#.01) of the MHSS INTAKE File (#9002011.07)
;
D HDR("I135",I)
S D0=DFN ;DINUMED
Q:'$D(^AMHPINTK(D0))
D WRITE(D0,DFN,.CNT)
Q
I136(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the MHSS RECORD HEALTH FACTORS File (#9002011.08)
;
D HDR("I136",I)
S D0=0
F S D0=$O(^AMHRHF(D0)) Q:'D0 D
. Q:$P($G(^AMHRHF(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I137(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the MHSS RECORD PREVENTION ACTIVITES File (#9002011.09)
;
D HDR("I137",I)
S D0=0
F S D0=$O(^AMHRPA(D0)) Q:'D0 D
. Q:$P($G(^AMHRPA(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I138(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the MHSS RECORD NAVAJO REFERRAL FORM File (#9002011.11)
;
D HDR("I138",I)
S D0=0
F S D0=$O(^AMHRNRF(D0)) Q:'D0 D
. Q:$P($G(^AMHRNRF(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I139(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the MHSS PATIENT PROBLEM LIST File (#9002011.51)
;
D HDR("I139",I)
S D0=0
F S D0=$O(^AMHPPROB(D0)) Q:'D0 D
. Q:$P($G(^AMHPPROB(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I140(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the MHSS PATIENT PERSONAL HX File (#9002011.52)
;
D HDR("I140",I)
S D0=0
F S D0=$O(^AMHPPHX(D0)) Q:'D0 D
. Q:$P($G(^AMHPPHX(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I141(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the MHSS PATIENT TREATMENT NOTES File (#9002011.53)
;
D HDR("I141",I)
S D0=0
F S D0=$O(^AMHPTP(D0)) Q:'D0 D
. Q:$P($G(^AMHPTP(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I142(DFN,I,CNT) ;
;----- PATIENT NAME field (#.01) of the MHSS PATIENT DATA File (#9002011.55)
;
D HDR("I142",I)
S D0=DFN ;DINUMED
Q:'$D(^AMHPATR(D0))
D WRITE(D0,DFN,.CNT)
Q
I143(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the MHSS PATIENT TREATMENT PLANS File (#9002011.56)
;
D HDR("I143",I)
S D0=0
F S D0=$O(^AMHPTXP(D0)) Q:'D0 D
. Q:$P($G(^AMHPTXP(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I144(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the *MHSS PATIENT TX PLAN METHODS File (#9002011.57)
;
D HDR("I144",I)
S D0=0
F S D0=$O(^AMHPTXPG(D0)) Q:'D0 D
. Q:$P($G(^AMHPTXPG(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I145(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the MHSS CASE DATES File (#9002011.58)
;
D HDR("I145",I)
S D0=0
F S D0=$O(^AMHPCASE(D0)) Q:'D0 D
. Q:$P($G(^AMHPCASE(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I146(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the *MHSS PATIENT TP PROBLEMS File (#9002011.62)
;
D HDR("I146",I)
S D0=0
F S D0=$O(^AMHPTPP(D0)) Q:'D0 D
. Q:$P($G(^AMHPTPP(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I147(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the *MHSS PATIENT TP GOALS 2 File (#9002011.63)
;
D HDR("I147",I)
S D0=0
F S D0=$O(^AMHPTPGL(D0)) Q:'D0 D
. Q:$P($G(^AMHPTPGL(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I148(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the *MHSS PATIENT TP METHODS File (#9002011.64)
;
D HDR("I148",I)
S D0=0
F S D0=$O(^AMHPTPM(D0)) Q:'D0 D
. Q:$P($G(^AMHPTPM(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I149(DFN,I,CNT) ;
;----- PATIENT field (#.04) of the MHSS SUICIDE FORMS File (#9002011.65)
;
D HDR("I149",I)
S D0=0
F S D0=$O(^AMHPSUIC(D0)) Q:'D0 D
. Q:$P($G(^AMHPSUIC(D0,0)),U,4)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I150(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the CHEF NUMBER sub-field (#9002064.11) of the CHS CHEF REGISTRY File (#9002064.1)
;
D HDR("I150",I)
S D0=0
F S D0=$O(^ACHSCHEF(D0)) Q:'D0 D
. S D1=0
. F S D1=$O(^ACHSCHEF(D0,1,D1)) Q:'D1 D
. . Q:$P($G(^ACHSCHEF(D0,1,D1,0)),U,2)'=DFN
. . W !?5,D0,?15,D1,?25,DFN
. . S CNT=$G(CNT)+1
Q
I151(DFN,I,CNT) ;
;----- REGISTERED PATIENT field (#6) of the CHS DEFERRED SERVICE NUMBER sub-field (#9002066.01) of the CHS DEFERRED SERVICE DATA File (#9002066)
;
D HDR("I151",I)
S D0=0
F S D0=$O(^ACHSDEF(D0)) Q:'D0 D
. S D1=0
. F S D1=$O(^ACHSDEF(D0,"D",D1)) Q:'D1 D
. . Q:$P($G(^ACHSDEF(D0,"D",D1,0)),U,6)'=DFN
. . W !?5,D0,?15,D1,?25,DFN
. . S CNT=$G(CNT)+1
Q
I152(DFN,I,CNT) ;
;----- REGISTERED PATIENT field (#7) of the DENIAL NUMBER sub-field (#9002071.01) of the CHS DENIAL DATA File (#9002071)
;
D HDR("I152",I)
S D0=0
F S D0=$O(^ACHSDEN(D0)) Q:'D0 D
. S D1=0
. F S D1=$O(^ACHSDEN(D0,"D",D1)) Q:'D1 D
. . Q:$P($G(^ACHSDEN(D0,"D",D1,0)),U,7)'=DFN
. . W !?5,D0,?15,D1,?25,DFN
. . S CNT=$G(CNT)+1
Q
I153(DFN,I,CNT) ;
;----- PATIENT field (#13.64) of the DOCUMENT sub-field (#9002080.01) of the CHS FACILITY File (#9002080)
;
D HDR("I153",I)
S D0=0
F S D0=$O(^ACHSF(D0)) Q:'D0 D
. S D1=0
. F S D1=$O(^ACHSF(D0,"D",D1)) Q:'D1 D
. . Q:$P($G(^ACHSF(D0,"D",D1,0)),U,22)'=DFN
. . W !?5,D0,?15,D1,?25,DFN
. . S CNT=$G(CNT)+1
Q
I154(DFN,I,CNT) ;
;----- PATIENT field (#2) of the TRANSACTION RECORD sub-field (#9002080.02) of the DOCUMENT sub-field (#9002080.01) of the CHS FACILITY File (#9002080)
;
D HDR("I154",I)
S D0=0
F S D0=$O(^ACHSF(D0)) Q:'D0 D
. S D1=0
. F S D1=$O(^ACHSF(D0,"D",D1)) Q:'D1 D
. . S D2=0
. . F S D2=$O(^ACHSF(D0,"D",D1,"T",D2)) Q:'D2 D
. . . Q:$P($G(^ACHSF(D0,"D",D1,"T",D2,0)),U,3)'=DFN
. . . W !?5,D0,?15,D1,?25,D2,?35,DFN
. . . S CNT=$G(CNT)+1
Q
I155(DFN,I,CNT) ;
;----- NAME field (#.01) of the BI PATIENT File (#9002084)
;
D HDR("I155",I)
S D0=DFN ;DINUMED
Q:'$D(^BIP(D0))
D WRITE(D0,DFN,.CNT)
Q
I156(DFN,I,CNT) ;
;----- PATIENT NAME field (#.01) of the BI PATIENT IMMUNIZATIONS DUE File (#9002084.1)
;
D HDR("I156",I)
S D0=0
F S D0=$O(^BIPDUE(D0)) Q:'D0 D
. Q:$P($G(^BIPDUE(D0,0)),U)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I157(DFN,I,CNT) ;
;----- PATIENT NAME field (#.01) of the BI PATIENT CONTRAINDICATIONS File (#9002084.11)
;
D HDR("I157",I)
S D0=0
F S D0=$O(^BIPC(D0)) Q:'D0 D
. Q:$P($G(^BIPC(D0,0)),U)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I158(DFN,I,CNT) ;
;----- NAME field (#.01) of the MCH PATIENT File (#9002085)
;
D HDR("I158",I)
S D0=DFN ;DINUMED
Q:'$D(^AMCH(85,D0))
D WRITE(D0,DFN,.CNT)
Q
I159(DFN,I,CNT) ;
;----- NAME field (#.01) of the BW PATIENT File (#9002086)
;
D HDR("I159",I)
S D0=DFN ;DINUMED
Q:'$D(^BWP(D0))
D WRITE(D0,DFN,.CNT)
Q
I160(DFN,I,CNT) ;
;----- NAME field (#.02) of the QA CHS ADMISSION File (#9002157)
;
D HDR("I160",I)
S D0=0
F S D0=$O(^AQACHSAD(D0)) Q:'D0 D
. Q:$P($G(^AQACHSAD(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I161(DFN,I,CNT) ;
;----- NAME field (#.02) of the QA IHS ADMISSION File (#9002159)
;
D HDR("I161",I)
S D0=0
F S D0=$O(^AQACIHS(D0)) Q:'D0 D
. Q:$P($G(^AQACIHS(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I162(DFN,I,CNT) ;
;----- PATIENT field (#.03) of the QI OCC CRITERIA File (#9002166.5)
;
D HDR("I162",I)
S D0=0
F S D0=$O(^AQAOCC(5,D0)) Q:'D0 D
. Q:$P($G(^AQAOCC(5,D0,0)),U,3)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I163(DFN,I,CNT) ;
;----- PATIENT field (#.03) of the QI OCC DRUG File (#9002166.6)
;
D HDR("I163",I)
S D0=0
F S D0=$O(^AQAOCC(6,D0)) Q:'D0 D
. Q:$P($G(^AQAOCC(6,D0,0)),U,3)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I164(DFN,I,CNT) ;
;----- PATIENT field (#.03) of the QI OCC PROVIDER File (#9002166.7)
;
D HDR("I164",I)
S D0=0
F S D0=$O(^AQAOCC(7,D0)) Q:'D0 D
. Q:$P($G(^AQAOCC(7,D0,0)),U,3)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I165(DFN,I,CNT) ;
;----- PATIENT field (#.03) of the QI OCC DIAGNOSIS File (#9002166.8)
;
D HDR("I165",I)
S D0=0
F S D0=$O(^AQAOCC(8,D0)) Q:'D0 D
. Q:$P($G(^AQAOCC(8,D0,0)),U,3)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I166(DFN,I,CNT) ;
;----- PATIENT field (#.03) of the QI OCC PROCEDURE File (#9002166.9)
;
D HDR("I166",I)
S D0=0
F S D0=$O(^AQAOCC(9,D0)) Q:'D0 D
. Q:$P($G(^AQAOCC(9,D0,0)),U,3)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I167(DFN,I,CNT) ;
;----- PATIENT NAME field (#.02) of the QI OCCURRENCE File (#9002167)
;
D HDR("I167",I)
S D0=0
F S D0=$O(^AQAOC(D0)) Q:'D0 D
. Q:$P($G(^AQAOC(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I168(DFN,I,CNT) ;
;----- CLIENTS NAME field (#4) of the CDMIS VISIT File (#9002172.1)
;
D HDR("I168",I)
S D0=0
F S D0=$O(^ACDVIS(D0)) Q:'D0 D
. Q:$P($G(^ACDVIS(D0,0)),U,5)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I169(DFN,I,CNT) ;
;----- CLIENT field (#.01) of the CLIENT sub-field (#9002172.81) of the CDMIS CLIENT CATEGORY File (#9002172.8)
;
D HDR("I169",I)
S D0=0
F S D0=$O(^ACDPAT(D0)) Q:'D0 D
. S D1=DFN ;DINUMED
. Q:'$D(^ACDPAT(D0,1,D1))
. W ?5,D0,?15,D1,?25,DFN
. S CNT=$G(CNT)+1
Q
I170(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the CDMIS BILL File (#9002172.9
;
D HDR("I170",I)
S D0=0
F S D0=$O(^ACDBILL(D0)) Q:'D0 D
. Q:$P($G(^ACDBILL(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I171(DFN,I,CNT) ;
;----- PATIENT field (#.01) of the PATIENT sub-field (#9002227.01101) of the PT TAXONOMY File (#9002227)
;
D HDR("I171",I)
S D0=0
F S D0=$O(^ATXPAT(D0)) Q:'D0 D
. S D1=DFN ;DINUMED
. Q:'$D(^ATXPAT(D0,11,D1))
. W ?5,D0,?15,D1,?25,DFN
. S CNT=$G(CNT)+1
Q
I172(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the CIC VISIT File (#9002230)
;
D HDR("I172",I)
S D0=0
F S D0=$O(^ACI(30,D0)) Q:'D0 D
. Q:$P($G(^ACI(30,D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I173(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the CMS REGISTER File (#9002241)
;
D HDR("I173",I)
S D0=0
F S D0=$O(^ACM(41,D0)) Q:'D0 D
. Q:$P($G(^ACM(41,D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I174(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the CMS COMPLICATION FOR THE CLIENT File (#9002242)
;
D HDR("I174",I)
S D0=0
F S D0=$O(^ACM(42,D0)) Q:'D0 D
. Q:$P($G(^ACM(42,D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I175(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the CMS INTERVENTION PLAN File (#9002243)
;
D HDR("I175",I)
S D0=0
F S D0=$O(^ACM(43,D0)) Q:'D0 D
. Q:$P($G(^ACM(43,D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I176(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the CMS DIAGNOSIS FOR THE CLIENT File (#9002244)
;
D HDR("I176",I)
S D0=0
F S D0=$O(^ACM(44,D0)) Q:'D0 D
. Q:$P($G(^ACM(44,D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I177(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the CMS RISK FACTOR FOR THE CLIENT File (#9002245)
;
D HDR("I177",I)
S D0=0
F S D0=$O(^ACM(45,D0)) Q:'D0 D
. Q:$P($G(^ACM(45,D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I178(DFN,I,CNT) ;
;----- FAMILY MEMBER field (#.01) of the CMS FAMILY MEMBERS File (#9002246)
;
D HDR("I178",I)
S D0=0
F S D0=$O(^ACM(46,D0)) Q:'D0 D
. Q:$P($G(^ACM(46,D0,0)),U)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I179(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the CMS FAMILY MEMBERS File (#9002246)
;
D HDR("I179",I)
S D0=0
F S D0=$O(^ACM(46,D0)) Q:'D0 D
. Q:$P($G(^ACM(46,D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I180(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the CMS SERVICE FOR THE CLIENT File (#9002247)
;
D HDR("I180",I)
S D0=0
F S D0=$O(^ACM(47,D0)) Q:'D0 D
. Q:$P($G(^ACM(47,D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I181(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the CMS CARE PLAN FOR THE CLIENT File (#9002248)
;
D HDR("I181",I)
S D0=0
F S D0=$O(^ACM(48,D0)) Q:'D0 D
. Q:$P($G(^ACM(48,D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I182(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the CMS APPOINTMENT File (#9002249)
;
D HDR("I182",I)
S D0=0
F S D0=$O(^ACM(49,D0)) Q:'D0 D
. Q:$P($G(^ACM(49,D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I183(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the CMS REGISTER CRITERIA FOR THE CLIENT File (#9002251)
;
D HDR("I183",I)
S D0=0
F S D0=$O(^ACM(51,D0)) Q:'D0 D
. Q:$P($G(^ACM(51,D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I184(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the CMS ETIOLOGY FOR THIS CLIENT File (#9002253)
;
D HDR("I184",I)
S D0=0
F S D0=$O(^ACM(53,D0)) Q:'D0 D
. Q:$P($G(^ACM(53,D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I185(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the CMS MEDICATIONS FOR THE CLIENT File (#9002254)
;
D HDR("I185",I)
S D0=0
F S D0=$O(^ACM(54,D0)) Q:'D0 D
. Q:$P($G(^ACM(54,D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I186(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the CMS MEASUREMENT File (#9002257)
;
D HDR("I186",I)
S D0=0
F S D0=$O(^ACM(57,D0)) Q:'D0 D
. Q:$P($G(^ACM(57,D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I187(DFN,I,CNT) ;
;----- PATIENT'S NAME field (#1) of the PRIVATE INS FACILITY BILLING File (#9002273.02)
;
D HDR("I187",I)
S D0=0
F S D0=$O(^ABPVFAC(D0)) Q:'D0 D
. Q:$P($G(^ABPVFAC(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I188(DFN,I,CNT) ;
;----- PATIENT field (#.01) of the 3P CLAIM DATA File (#9002274.3)
;
D HDR("I188",I)
S DUZ2=0
F S DUZ2=$O(^ABMDCLM(DUZ2)) Q:'DUZ2 D
. S D0=0
. F S D0=$O(^ABMDCLM(DUZ2,D0)) Q:'D0 D
. . Q:$P($G(^ABMDCLM(DUZ2,D0,0)),U)'=DFN
. . W !?5,DUZ2,?15,D0,?25,DFN
. . S CNT=$G(CNT)+1
Q
I189(DFN,I,CNT) ;
;----- PATIENT field (#.05) of the 3P BILL File (#9002274.4)
;
D HDR("I189",I)
S DUZ2=0
F S DUZ2=$O(^ABMDBILL(DUZ2)) Q:'DUZ2 D
. S D0=0
. F S D0=$O(^ABMDBILL(DUZ2,D0)) Q:'D0 D
. . Q:$P($G(^ABMDBILL(DUZ2,D0,0)),U,5)'=DFN
. . W !?5,DUZ2,?15,D0,?25,DFN
. . S CNT=$G(CNT)+1
Q
I190(DFN,I,CNT) ;
;----- PATIENT field (#5) of the ABSP LOG OF TRANSACTIONS File (#9002313.57)
;
D HDR("I190",I)
S D0=0
F S D0=$O(^ABSPTL(D0)) Q:'D0 D
. Q:$P($G(^ABSPTL(D0,0)),U,6)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I191(DFN,I,CNT) ;
;----- PATIENT field (#5) of the ABSP TRANSACTION File (#9002313.59)
;
D HDR("I191",I)
S D0=0
F S D0=$O(^ABSPT(D0)) Q:'D0 D
. Q:$P($G(^ABSPT(D0,0)),U,6)'=DFN
. W !?5,D0," ",DFN
. S CNT=$G(CNT)+1
Q
I192(DFN,I,CNT) ;
;----- PATIENT NAME field (#.01) of the DAY SURGERY File (#9009012)
;
D HDR("I192",I)
S D0=DFN ;DINUMED
Q:'$D(^ADGDS(D0))
D WRITE(D0,DFN,.CNT)
Q
I193(DFN,I,CNT) ;
;----- NAME field (#.01) of the DS INCOMPLETE CHART File (#9009012.5)
;
D HDR("I193",I)
S D0=DFN ;DINUMED
Q:'$D(^ADGDSI(D0))
D WRITE(D0,DFN,.CNT)
Q
I194(DFN,I,CNT) ;
;----- PATIENT NAME field (#.01) of the INCOMPLETE CHART File (#9009013)
;
D HDR("I194",I)
S D0=DFN ;DINUMED
Q:'$D(^ADGIC(D0))
D WRITE(D0,DFN,.CNT)
Q
I195(DFN,I,CNT) ;
;----- NAME field (#.01) of the SCHEDULED VISIT File (#9009013.1)
;
D HDR("I195",I)
S D0=DFN ;DINUMED
Q:'$D(^ADGAUTH(D0))
D WRITE(D0,DFN,.CNT)
Q
I196(DFN,I,CNT) ;
;----- PATIENT field (#.01) of the PATIENT sub-field (#9009015.01) of the WAITING LIST CLINIC File (#9009015)
;
D HDR("I196",I)
S D0=0
F S D0=$O(^ASDWL(D0)) Q:'D0 D
. S D1=0
. F S D1=$O(^ASDWL(D0,1,D1)) Q:'D1 D
. . Q:$P($G(^ASDWL(D0,1,D1,0)),U)'=DFN
. . W !?5,D0,?15,D1,?25,DFN
. . S CNT=$G(CNT)+1
Q
I197(DFN,I,CNT) ;
;----- PATIENT field (#.04) of the BLRA LAB AUDIT File (#9009027)
;
D HDR("I197",I)
S D0=0
F S D0=$O(^BLRALAB(9009027,D0)) Q:'D0 D
. Q:$P($G(^BLRALAB(9009027,D0,0)),U,4)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I198(DFN,I,CNT) ;
;----- PATIENT field (#.04) of the APSP DUE REVIEW File (#9009032)
;
D HDR("I198",I)
S D0=0
F S D0=$O(^APSPDUE(32,D0)) Q:'D0 D
. Q:$P($G(^APSPDUE(32,D0,0)),U,4)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I199(DFN,I,CNT) ;
;----- PATIENT field (#2) of the NON FORMULARY REQUESTS File (#9009035.1)
;
D HDR("I199",I)
S D0=0
F S D0=$O(^APSQNF(D0)) Q:'D0 D
. Q:$P($G(^APSQNF(D0,0)),U,3)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I200(DFN,I,CNT) ;
;----- PATIENT field (#.04) of the ANS NURSE ACUITY RECORD File (#9009052)
;
D HDR("I200",I)
S D0=0
F S D0=$O(^ANSR(D0)) Q:'D0 D
. Q:$P($G(^ANSR(D0,0)),U,4)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I201(DFN,I,CNT) ;
;----- PATIENTS ADDED field (#.01) of the PATIENTS ADDED sub-field (#9009062.021) of the AG ELIGIBILITY UPLOAD LOG File (#9009062.02)
;
D HDR("I201",I)
S D0=0
F S D0=$O(^AGELUPLG(D0)) Q:'D0 D
. S D1=DFN ;DINUMED
. Q:'$D(^AGELUPLG(D0,1,D1))
. W !?5,D0,?15,D1,?25,DFN
. S CNT=$G(CNT)+1
Q
I202(DFN,I,CNT) ;
;----- PATIENTS EDITED field (#.01) of the PATIENTS EDITED sub-field (#9009062.022) of the AG ELIGIBILITY UPLOAD LOG File (#9009062.02)
;
D HDR("I202",I)
S D0=0
F S D0=$O(^AGELUPLG(D0)) Q:'D0 D
. S D1=DFN ;DINUMED
. Q:'$D(^AGELUPLG(D0,2,D1))
. W !?5,D0,?15,D1,?25,DFN
. S CNT=$G(CNT)+1
Q
I203(DFN,I,CNT) ;
;----- NAME field (#.01) of the AGVQ VERIQUEST PATIENT File (#9009062.08)
;
D HDR("I203",I)
S D0=DFN ;DINUMED
Q:'$D(^AGVQP(D0))
D WRITE(D0,DFN,.CNT)
Q
I204(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the AG MESSAGE TRANSACTIONS File (#9009063.1)
;
D HDR("I204",I)
S D0=0
F S D0=$O(^AGTXMSG(D0)) Q:'D0 D
. Q:$P($G(^AGTXMSG(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I205(DFN,I,CNT) ;
;----- PATIENT field (#.01) of the PATIENT sub-field (#9009065.05) of the REGISTRATION MAILING LIST File (#9009065)
;
D HDR("I205",I)
S D0=0
F S D0=$O(^AGADLIST(D0)) Q:'D0 D
. S D1=0
. F S D1=$O(^AGADLIST(D0,1,D1)) Q:'D1 D
. . Q:$P($G(^AGADLIST(D0,1,D1,0)),U)'=DFN
. . W !?5,D0,?15,D1,?25,DFN
. . S CNT=$G(CNT)+1
Q
I206(DFN,I,CNT) ;
;----- PATIENT NAME field (#.01) of the AGEV INSURANCE ELIGIBILITY HOLDING File (#9009066)
;
D HDR("I206",I)
S D0=0
F S D0=$O(^AGEVH(D0)) Q:'D0 D
. Q:$P($G(^AGEVH(D0,0)),U)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I207(DFN,I,CNT) ;
;----- PATIENT field (#.02) of the ER VISIT File (#9009080)
;
D HDR("I207",I)
S D0=0
F S D0=$O(^AMERVSIT(D0)) Q:'D0 D
. Q:$P($G(^AMERVSIT(D0,0)),U,2)'=DFN
. D WRITE(D0,DFN,.CNT)
Q
I208(DFN,I,CNT) ;
;----- PATIENT field (#.01) of the ER ADMISSION File (#9009081)
;
D HDR("I208",I)
S D0=DFN ;DINUMED
Q:'$D(^AMERADM(D0))
D WRITE(D0,DFN,.CNT)
Q
HDR(X,I) ;
;----- WRITE HEADER
;
W !!,I," ",$T(@(X)+1),!
Q
WRITE(D0,X,CNT) ;
;----- WRITE FINDINGS
;
W !?5,D0,?15,X
S CNT=$G(CNT)+1
Q
QUE(DFN) ;
;
N %ZIS,POP,ZTDESC,ZTIO,ZTRTN,ZTSAVE
;
S ZTSAVE("DFN")=""
S ZTRTN="DQ^AZAXDPM1"
S ZTDESC="FIND 'IHS' PATIENT FILE POINTERS"
;
S %ZIS="Q"
D ^%ZIS
Q:POP
I $D(IO("Q")) D Q
. K IO("Q")
. S ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
. D ^%ZTLOAD
. W !,"Task #",$G(ZTSK)," queued"
D @ZTRTN
Q
AZAXDPM1 ;IHS/PHXAO/AEF - FIND IHS PATIENT FILE POINTERS FOR PATIENT MERGE PROCESS
+1 ;;1.0;ANNE'S SPECIAL ROUTINES;;AUG 23, 2004
+2 ;;
+3 ;;THIS ROUTINE SEARCHES EACH POINTER TO THE IHS PATIENT FILE
+4 ;;FOR THE SPECIFIED POINTER VALUE
+5 ;;
EN ;EP -- MAIN ENTRY POINT
+1 ;
+2 NEW DFN,Y
+3 ;
+4 DO ^XBKVAR
+5 DO HOME^%ZIS
+6 ;
+7 DO SEL(.Y)
+8 IF Y'>0
QUIT
+9 SET DFN=+Y
+10 ;
+11 DO DO(DFN)
+12 QUIT
SEL(DFN) ;
+1 ;----- SELECT DFN TO SEARCH FOR
+2 ;
+3 NEW DIR,X
+4 SET DIR(0)="N"
+5 SET DIR("A")="Select DFN to search for"
+6 DO ^DIR
+7 QUIT +Y
DO(DFN) ;
+1 ;----- PROCESS POINTERS
+2 ;
+3 DO QUE(DFN)
+4 QUIT
DQ ;EP -- QUEUED JOB STARTS HERE
+1 ;
+2 DO PRT(DFN)
+3 DO ^%ZISC
+4 QUIT
PRT(DFN) ;
+1 ;----- PRINT THE REPORT
+2 ;
+3 NEW CNT,D0,D1,D2,DUZ2,I,ROU,X
+4 WRITE @IOF
+5 WRITE !,"FINDING IHS 'PATIENT' FILE POINTERS FOR PATIENT ",$PIECE($GET(^DPT(DFN,0)),U)," DFN #",DFN,!
+6 SET CNT=0
+7 FOR I=1:1:208
Begin DoDot:1
+8 SET ROU="I"_I_"("_DFN_","_I_","_".CNT"_")"
+9 DO @ROU
End DoDot:1
+10 ;
+11 WRITE !!,CNT," POINTERS FOUND",!
+12 QUIT
I1(DFN,I,CNT) ;
+1 ;----- NAME field (#.01) of the USER MENU File (#112.6)
+2 ;
+3 DO HDR("I1",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^FHUM(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 SET X=$PIECE(^FHUM(D0,0),U)
+7 IF +X'=DFN
QUIT
+8 IF "^DFN(^AUPNPAT("'[$PIECE(X,";",2)
QUIT
+9 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+10 QUIT
I2(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.01) of the NCI CANCER REGISTER PATIENT FILE File (#19259.02)
+2 ;
+3 DO HDR("I2",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^CIMSCPAT(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I3(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the VEN EHP AUDIT TRAIL File (#19707.8)
+2 ;
+3 DO HDR("I3",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^VEN(7.8,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^VEN(7.8,D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I4(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.03) of the RCIS REFERRAL File (#90001)
+2 ;
+3 DO HDR("I4",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^BMCREF(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^BMCREF(D0,0)),U,3)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I5(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the RCIS DIAGNOSIS File (#90001.01)
+2 ;
+3 DO HDR("I5",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^BMCDX(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^BMCDX(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I6(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the RCIS PROCEDURE File (#90001.02)
+2 ;
+3 DO HDR("I6",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^BMCPX(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^BMCPX(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I7(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the RCIS CASE REVIEW COMMENTS File (#90001.03)
+2 ;
+3 DO HDR("I7",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^BMCCOM(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^BMCCOM(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I8(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the RCIS SECONDARY PROVIDER LETTER File (#90001.04)
+2 ;
+3 DO HDR("I8",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^BMCPROV(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^BMCPROV(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I9(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.04) of the CHR RECORD File (#90002)
+2 ;
+3 DO HDR("I9",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^BCHR(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^BCHR(D0,0)),U,4)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I10(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the CHR POV File (#90002.01)
+2 ;
+3 DO HDR("I10",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^BCHRPROB(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^BCHRPROB(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I11(DFN,I,CNT) ;
+1 ;----- PATIENT field (#101) of the A/R BILL/IHS File (#90050.01)
+2 ;
+3 DO HDR("I11",I)
+4 SET DUZ2=0
+5 FOR
SET DUZ2=$ORDER(^BARBL(DUZ2))
IF 'DUZ2
QUIT
Begin DoDot:1
+6 SET D0=0
+7 FOR
SET D0=$ORDER(^BARBL(DUZ2,D0))
IF 'D0
QUIT
Begin DoDot:2
+8 IF $PIECE($GET(^BARBL(DUZ2,D0,1)),U)'=DFN
QUIT
+9 WRITE !?5,DUZ2,?15,D0,?25,DFN
+10 SET CNT=$GET(CNT)+1
End DoDot:2
End DoDot:1
+11 QUIT
I12(DFN,I,CNT) ;
+1 ;----- ACCOUNT field (#.01) of the A/R ACCOUNTS/IHS File (#90050.02)
+2 ;
+3 DO HDR("I12",I)
+4 SET DUZ2=0
+5 FOR
SET DUZ2=$ORDER(^BARAC(DUZ2))
IF 'DUZ2
QUIT
Begin DoDot:1
+6 SET D0=0
+7 FOR
SET D0=$ORDER(^BARAC(DUZ2,D0))
IF 'D0
QUIT
Begin DoDot:2
+8 SET X=$PIECE($GET(^BARAC(DUZ2,D0,0)),U)
+9 IF +X'=DFN
QUIT
+10 IF "^DFN(^AUPNPAT("'[$PIECE(X,";",2)
QUIT
+11 WRITE !?5,DUZ2,?15,D0,?25,DFN
+12 SET CNT=$GET(CNT)+1
End DoDot:2
End DoDot:1
+13 QUIT
I13(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.01) of the PATIENT sub-field (#90050.0211) of the A/R ACCOUNTS/IHS File (#90050.02)
+2 ;
+3 DO HDR("I13",I)
+4 SET DUZ2=0
+5 FOR
SET DUZ2=$ORDER(^BARAC(DUZ2))
IF 'DUZ2
QUIT
Begin DoDot:1
+6 SET D0=0
+7 FOR
SET D0=$ORDER(^BARAC(DUZ2,D0))
IF 'D0
QUIT
Begin DoDot:2
+8 SET D1=0
+9 FOR
SET D1=$ORDER(^BARAC(DUZ2,D0,11,D1))
IF 'D1
QUIT
Begin DoDot:3
+10 IF $PIECE($GET(^BARAC(DUZ2,D0,11,D1,0)),U)'=DFN
QUIT
+11 WRITE !?5,DUZ2,?15,D0,?25,D1,?35,DFN
+12 SET CNT=$GET(CNT)+1
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
I14(DFN,I,CNT) ;
+1 ;----- PATIENT (A/R) field (#5) of the A/R TRANSACTIONS/IHS File (#90050.03)
+2 ;
+3 DO HDR("I14",I)
+4 SET DUZ2=0
+5 FOR
SET DUZ2=$ORDER(^BARTR(DUZ2))
IF 'DUZ2
QUIT
Begin DoDot:1
+6 SET D0=0
+7 FOR
SET D0=$ORDER(^BARTR(DUZ2,D0))
IF 'D0
QUIT
Begin DoDot:2
+8 IF $PIECE($GET(^BARTR(DUZ2,D0,0)),U,5)'=DFN
QUIT
+9 WRITE !?5,DUZ2,?15,D0,?25,DFN
+10 SET CNT=$GET(CNT)+1
End DoDot:2
End DoDot:1
+11 QUIT
I15(DFN,I,CNT) ;
+1 ;----- PATIENT field (#5) of the ITEM(S) sub-field (#90051.1101) of the A/R COLLECTION BATCH/IHS File (#90051.01)
+2 ;
+3 DO HDR("I15",I)
+4 SET DUZ2=0
+5 FOR
SET DUZ2=$ORDER(^BARCOL(DUZ2))
IF 'DUZ2
QUIT
Begin DoDot:1
+6 SET D0=0
+7 FOR
SET D0=$ORDER(^BARCOL(DUZ2,D0))
IF 'D0
QUIT
Begin DoDot:2
+8 SET D1=0
+9 FOR
SET D1=$ORDER(^BARCOL(DUZ2,D0,1,D1))
IF 'D1
QUIT
Begin DoDot:3
+10 IF $PIECE($GET(^BARCOL(DUZ2,D0,1,D1,0)),U,6)'=DFN
QUIT
+11 WRITE !?5,DUZ2,?15,D0,?25,D1,?35,DFN
+12 SET CNT=$GET(CNT)+1
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
I16(DFN,I,CNT) ;
+1 ;----- A/R PATIENT field (#.12) of the A/R EDI 835 HOLDING File (#90056.07)
+2 ;
+3 DO HDR("I16",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^BAR835(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^BAR835(D0,1)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I17(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the BPC ORDERABLES File (#90080)
+2 ;
+3 DO HDR("I17",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^BPCORD(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^BPCORD(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I18(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.01) of the ASTHMA REGISTER File (#90181.01)
+2 ;
+3 DO HDR("I18",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^BATREG(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I19(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.03) of the ROI LISTING RECORD File (#90264)
+2 ;
+3 DO HDR("I19",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^BRNREC(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^BRNREC(D0,0)),U,3)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I20(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.03) of the BZD PYXIS REGISTRATION LOG File (#1410004)
+2 ;
+3 DO HDR("I20",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^BZDPLOG(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^BZDPLOG(D0,0)),U,3)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I21(DFN,I,CNT) ;
+1 ;----- Patient Pointer field (#.12) of the BZD PYXIS BILLS File (#1410005)
+2 ;
+3 DO HDR("I21",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^BZDPBILL(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^BZDPBILL(D0,0)),U,12)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I22(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.03) of the ROI DISCLOSURE File (#1991075)
+2 ;
+3 DO HDR("I22",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AZXAREC(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AZXAREC(D0,0)),U,3)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I23(DFN,I,CNT) ;
+1 ;----- NAME field (#.01) of the SUICIDE File (#8000000)
+2 ;
+3 DO HDR("I23",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^DIZ(8000000,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^DIZ(8000000,D0,0)),U)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I24(DFN,I,CNT) ;
+1 ;----- NAME field (#.01) of the PRENATAL REGISTER File (#8000001)
+2 ;
+3 DO HDR("I24",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^DIZ(8000001,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^DIZ(8000001,D0,0)),U)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I25(DFN,I,CNT) ;
+1 ;----- NAME field (#.01) of the EYE CLINIC RECALL File (#8000008)
+2 ;
+3 DO HDR("I25",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^DIZ(8000008,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^DIZ(8000008,D0,0)),U)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I26(DFN,I,CNT) ;
+1 ;----- NAME field (#.01) of the PHN IMM File (#8000014)
+2 ;
+3 DO HDR("I26",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^DIZ(8000014,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^DIZ(8000014,D0,0)),U)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I27(DFN,I,CNT) ;
+1 ;----- NAME field (#.01) of the DIABETIC PATIENTS File (#8000016)
+2 ;
+3 DO HDR("I27",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^DIZ(8000016,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^DIZ(8000016,D0,0)),U)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I28(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.01) of the AZHQ 3P CLAIM DATA File (#8008604.3)
+2 ;
+3 DO HDR("I28",I)
+4 SET DUZ2=0
+5 FOR
SET DUZ2=$ORDER(^AZHQCLM(DUZ2))
IF 'DUZ2
QUIT
Begin DoDot:1
+6 SET D0=0
+7 FOR
SET D0=$ORDER(^AZHQCLM(DUZ2,D0))
IF 'D0
QUIT
Begin DoDot:2
+8 IF $PIECE($GET(^AZHQCLM(DUZ2,D0,0)),U)'=DFN
QUIT
+9 WRITE !?5,DUZ2,?15,D0,?25,DFN
+10 SET CNT=$GET(CNT)+1
End DoDot:2
End DoDot:1
+11 QUIT
I29(DFN,I,CNT) ;
+1 ;----- REGISTERED PATIENT field (#4.1) of the AZHQ CHS DENIAL DATA File (#8008607)
+2 ;
+3 DO HDR("I29",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AZHQDEN(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AZHQDEN(D0,0)),U,5)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I30(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the AZHQ PROBLEM File (#8008611)
+2 ;
+3 DO HDR("I30",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AZHQPROB(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AZHQPROB(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I31(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the AZHQ PERSONAL HISTORY File (#8008613)
+2 ;
+3 DO HDR("I31",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AZHQPH(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AZHQPH(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I32(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the AZHQ FAMILY HISTORY File (#8008614)
+2 ;
+3 DO HDR("I32",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AZHQFH(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AZHQFH(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I33(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.03) of the AZHQ QI OCC DIAGNOSIS File (#8008666.8)
+2 ;
+3 DO HDR("I33",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AZHQOCC(8,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AZHQOCC(8,D0,0)),U,3)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I34(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the File (#8008670.07)
+2 ;
+3 DO HDR("I34",I)
+4 WRITE !?5,"<FILE CORRUPTED!>"
+5 QUIT
I35(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.05) of the AZHQ 3P BILL File (#8008674.4)
+2 ;
+3 DO HDR("I35",I)
+4 SET DUZ2=0
+5 FOR
SET DUZ2=$ORDER(^AZHQBILL(DUZ2))
IF 'DUZ2
QUIT
Begin DoDot:1
+6 SET D0=0
+7 FOR
SET D0=$ORDER(^AZHQBILL(DUZ2,D0))
IF 'D0
QUIT
Begin DoDot:2
+8 IF $PIECE($GET(^AZHQBILL(DUZ2,D0,0)),U,5)'=DFN
QUIT
+9 WRITE !?5,DUZ2,?15,D0,?25,DFN
+10 SET CNT=$GET(CNT)+1
End DoDot:2
End DoDot:1
+11 QUIT
I36(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.05) of the AZHQ VISIT File (#8008675)
+2 ;
+3 DO HDR("I36",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AZHQVSIT(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AZHQVSIT(D0,0)),U,5)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I37(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the AZHQ V HOSPITALIZATION File (#8008675.02)
+2 ;
+3 DO HDR("I37",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AZHQVINP(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AZHQVINP(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I38(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the AZHQ V POV File (#8008675.07)
+2 ;
+3 DO HDR("I38",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AZHQVPOV(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AZHQVPOV(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I39(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the AZHQ V PROCEDURE File (#8008675.08)
+2 ;
+3 DO HDR("I39",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AZHQVPRC(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AZHQVPRC(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I40(DFN,I,CNT) ;
+1 ;----- PATIENT field (#13.64) of the DOCUMENT sub-field (#8008680.01) of the AZHQ CHS FACILITY File (#8008680)
+2 ;
+3 DO HDR("I40",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AZHQF(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 SET D1=0
+7 FOR
SET D1=$ORDER(^AZHQF(D0,"D",D1))
IF 'D1
QUIT
Begin DoDot:2
+8 IF $PIECE($GET(^AZHQF(D0,"D",D1,0)),U,22)'=DFN
QUIT
+9 WRITE !?5,D0,?15,D1,?25,DFN
+10 SET CNT=$GET(CNT)+1
End DoDot:2
End DoDot:1
+11 QUIT
I41(DFN,I,CNT) ;
+1 ;----- PATIENT field (#2) of the TRANSACTION RECORD sub-field (#8008680.02) of the DOCUMENT sub-field (#8008680.01) of the AZHQ CHS FACILITY File (#8008680)
+2 ;
+3 DO HDR("I41",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AZHQF(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 SET D1=0
+7 FOR
SET D1=$ORDER(^AZHQF(D0,"D",D1))
IF 'D1
QUIT
Begin DoDot:2
+8 SET D2=0
+9 FOR
SET D2=$ORDER(^AZHQF(D0,"D",D1,"T",D2))
IF 'D2
QUIT
Begin DoDot:3
+10 IF $PIECE($GET(^AZHQF(D0,"D",D1,"T",D2,0)),U,3)'=DFN
QUIT
+11 WRITE !?5,D0,?15,D1,?25,D2,?35,DFN
+12 SET CNT=$GET(CNT)+1
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
I42(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.01) of the *PRENATAL File (#9000002)
+2 ;
+3 DO HDR("I42",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^AUPNPNTL(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I43(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.01) of the MEDICARE ELIGIBLE File (#9000003)
+2 ;
+3 DO HDR("I43",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^AUPNMCR(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I44(DFN,I,CNT) ;
+1 ;----- PATIENT POINTER field (#.02) of the POLICY HOLDER File (#9000003.1)
+2 ;
+3 DO HDR("I44",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPN3PPH(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPN3PPH(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I45(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.01) of the MEDICAID ELIGIBLE File (#9000004)
+2 ;
+3 DO HDR("I45",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNMCD(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNMCD(D0,0)),U)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I46(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.01) of the RAILROAD ELIGIBLE File (#9000005)
+2 ;
+3 DO HDR("I46",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^AUPNRRE(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I47(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.01) of the PRIVATE INSURANCE ELIGIBLE File (#9000006)
+2 ;
+3 DO HDR("I47",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^AUPNPRVT(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I48(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the *SCHEDULED ENCOUNTER File (#9000007)
+2 ;
+3 DO HDR("I48",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNFSE(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNFSE(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I49(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.01) of the *SURVEILLANCE File (#9000008)
+2 ;
+3 DO HDR("I49",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNSURV(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNSURV(D0,0)),U)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I50(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.01) of the *CLINICAL REMINDER File (#9000009)
+2 ;
+3 DO HDR("I50",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNCR(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNCR(D0,0)),U)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I51(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.05) of the VISIT File (#9000010)
+2 ;
+3 DO HDR("I51",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVSIT(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVSIT(D0,0)),U,5)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I52(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V MEASUREMENT File (#9000010.01)
+2 ;
+3 DO HDR("I52",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVMSR(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVMSR(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I53(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V HOSPITALIZATION File (#9000010.02)
+2 ;
+3 DO HDR("I53",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVINP(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVINP(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I54(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V CHS File (#9000010.03)
+2 ;
+3 DO HDR("I54",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVCHS(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVCHS(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I55(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V EYE GLASS File (#9000010.04)
+2 ;
+3 DO HDR("I55",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVEYE(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVEYE(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I56(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V DENTAL File (#9000010.05)
+2 ;
+3 DO HDR("I56",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVDEN(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVDEN(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I57(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V PROVIDER File (#9000010.06)
+2 ;
+3 DO HDR("I57",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVPRV(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVPRV(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I58(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V POV File (#9000010.07)
+2 ;
+3 DO HDR("I58",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVPOV(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVPOV(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I59(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V PROCEDURE File (#9000010.08)
+2 ;
+3 DO HDR("I59",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVPRC(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVPRC(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I60(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V LAB File (#9000010.09)
+2 ;
+3 DO HDR("I60",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVLAB(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVLAB(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I61(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V IMMUNIZATION File (#9000010.11)
+2 ;
+3 DO HDR("I61",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVIMM(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVIMM(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I62(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V SKIN TEST File (#9000010.12)
+2 ;
+3 DO HDR("I62",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVSK(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVSK(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I63(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V EXAM File (#9000010.13)
+2 ;
+3 DO HDR("I63",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVXAM(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVXAM(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I64(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V MEDICATION File (#9000010.14)
+2 ;
+3 DO HDR("I64",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVMED(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVMED(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I65(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V TREATMENT File (#9000010.15)
+2 ;
+3 DO HDR("I65",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVTRT(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVTRT(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I66(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V PATIENT ED File (#9000010.16)
+2 ;
+3 DO HDR("I66",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVPED(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVPED(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I67(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V PHYSICAL THERAPY File (#9000010.17)
+2 ;
+3 DO HDR("I67",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVPT(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVPT(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I68(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V CPT File (#9000010.18)
+2 ;
+3 DO HDR("I68",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVCPT(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVCPT(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I69(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V ACTIVITY TIME File (#9000010.19)
+2 ;
+3 DO HDR("I69",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVTM(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVTM(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I70(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V DIAGNOSTIC PROCEDURE RESULT File (#9000010.21)
+2 ;
+3 DO HDR("I70",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVDXP(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVDXP(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I71(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V RADIOLOGY File (#9000010.22)
+2 ;
+3 DO HDR("I71",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVRAD(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVRAD(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I72(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V HEALTH FACTORS File (#9000010.23)
+2 ;
+3 DO HDR("I72",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVHF(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVHF(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I73(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V PATHOLOGY File (#9000010.24)
+2 ;
+3 DO HDR("I73",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVPTH(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVPTH(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I74(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V MICROBIOLOGY File (#9000010.25)
+2 ;
+3 DO HDR("I74",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVMIC(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVMIC(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I75(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the V NOTE File (#9000010.28)
+2 ;
+3 DO HDR("I75",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVNOT(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVNOT(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I76(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V EMERGENCY VISIT RECORD File (#9000010.29)
+2 ;
+3 DO HDR("I76",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVER(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVER(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I77(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V BLOOD BANK File (#9000010.31)
+2 ;
+3 DO HDR("I77",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVBB(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVBB(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I78(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V PHN File (#9000010.32)
+2 ;
+3 DO HDR("I78",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVPHN(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVPHN(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I79(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V TRANSACTION CODES File (#9000010.33)
+2 ;
+3 DO HDR("I79",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVTC(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVTC(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I80(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V NARRATIVE TEXT File (#9000010.34)
+2 ;
+3 DO HDR("I80",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVNT(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVNT(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I81(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V ELDER CARE File (#9000010.35)
+2 ;
+3 DO HDR("I81",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVELD(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVELD(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I82(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V TRANSACTION CHARGE File (#9000010.37)
+2 ;
+3 DO HDR("I82",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVTRC(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVTRC(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I83(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V UNHF File (#9000010.38)
+2 ;
+3 DO HDR("I83",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVUNH(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVUNH(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I84(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V TREATMENT CONTRACT File (#9000010.39)
+2 ;
+3 DO HDR("I84",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVTXC(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVTXC(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I85(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V ASTHMA File (#9000010.41)
+2 ;
+3 DO HDR("I85",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVAST(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVAST(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I86(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V PODIATRY File (#9000010.42)
+2 ;
+3 DO HDR("I86",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVPOD(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVPOD(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I87(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V VA MOBILE VISIT RELATED File (#9000010.701)
+2 ;
+3 DO HDR("I87",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVMVR(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVMVR(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I88(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V VA MOBILE VISIT TYPES File (#9000010.702)
+2 ;
+3 DO HDR("I88",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVMVT(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVMVT(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I89(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V VA MOBILE PRES ACTIONS File (#9000010.703)
+2 ;
+3 DO HDR("I89",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVMPA(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVMPA(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I90(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V VA MOBILE REFER FOR OUTP File (#9000010.704)
+2 ;
+3 DO HDR("I90",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVMRO(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVMRO(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I91(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V VA MOBILE SPECIALTY OF REFER File (#9000010.705)
+2 ;
+3 DO HDR("I91",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVMSP(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVMSP(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I92(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V VA MOBILE EXAMS ORDERED File (#9000010.706)
+2 ;
+3 DO HDR("I92",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVMEO(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVMEO(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I93(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the V LINE ITEM (GOODS&SERVICES) File (#9000010.99)
+2 ;
+3 DO HDR("I93",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNVLI(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVLI(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I94(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the PROBLEM File (#9000011)
+2 ;
+3 DO HDR("I94",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNPROB(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNPROB(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I95(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the OFFSPRING HISTORY File (#9000012)
+2 ;
+3 DO HDR("I95",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNOFFH(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNOFFH(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I96(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the PERSONAL HISTORY File (#9000013)
+2 ;
+3 DO HDR("I96",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNPH(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNPH(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I97(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the FAMILY HISTORY File (#9000014)
+2 ;
+3 DO HDR("I97",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNFH(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNFH(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I98(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the *UNMET SURGICAL NEED File (#9000015)
+2 ;
+3 DO HDR("I98",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNUMS(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNUMS(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I99(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the *HISTORY OF PROCEDURES File (#9000016)
+2 ;
+3 DO HDR("I99",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNHOS(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNHOS(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I100(DFN,I,CNT) ;
+1 ;----- NAME field (#.01) of the REPRODUCTIVE FACTORS File (#9000017)
+2 ;
+3 DO HDR("I100",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^AUPNREP(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I101(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the HEALTH STATUS File (#9000019)
+2 ;
+3 DO HDR("I101",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNHF(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNHF(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I102(DFN,I,CNT) ;
+1 ;----- NAME field (#.01) of the PT LAB RELATED DATA File (#9000020)
+2 ;
+3 DO HDR("I102",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^AUPNLABR(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I103(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the IHS HL7 SUPPLY INTERFACE File (#9000021)
+2 ;
+3 DO HDR("I103",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNSUP(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNSUP(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I104(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the PATIENT REFUSALS FOR SERVICE/NMI File (#9000022)
+2 ;
+3 DO HDR("I104",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNPREF(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNPREF(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I105(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.01) of the ELDER CARE File (#9000023)
+2 ;
+3 DO HDR("I105",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^AUPNELDC(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I106(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.01) of the BIRTH MEASUREMENT File (#9000024)
+2 ;
+3 DO HDR("I106",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^AUPNBMSR(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I107(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the HEALTH REMINDER OVERRIDE File (#9000025)
+2 ;
+3 DO HDR("I107",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNHMRO(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNHMRO(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I108(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the INCOME STATUS File (#9000026)
+2 ;
+3 DO HDR("I108",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNINCS(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNINCS(D0,0)),U,2)='DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I109(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.01) of the OPIOID STATUS File (#9000027)
+2 ;
+3 DO HDR("I109",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^AUPNOPIU(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I110(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the AUTO/LIABILITY File (#9000031)
+2 ;
+3 DO HDR("I110",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNAUTO(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNAUTO(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I111(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the WORKMAN'S COMP File (#9000032)
+2 ;
+3 DO HDR("I111",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNWRKC(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNWRKC(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I112(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the PATIENT NAME CHANGES File (#9000033)
+2 ;
+3 DO HDR("I112",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNNAMC(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNNAMC(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I113(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the PATIENT'S LEGAL DOCS File (#9000034)
+2 ;
+3 DO HDR("I113",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNPLDC(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNPLDC(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I114(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the CATEGORY PRIORITIZING File (#9000035)
+2 ;
+3 DO HDR("I114",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNICP(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNICP(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I115(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the PRE-CERTIFICATION File (#9000036)
+2 ;
+3 DO HDR("I115",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNPCRT(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNPCRT(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I116(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the MSP PATIENT File (#9000037)
+2 ;
+3 DO HDR("I116",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNMSP(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNMSP(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I117(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.01) of the NOTICE OF PRIVACY PRACTICES File (#9000038)
+2 ;
+3 DO HDR("I117",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^AUPNNPP(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I118(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.01) of the RESTRICTED HEALTH INFORMATION File (#9000039)
+2 ;
+3 DO HDR("I118",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNRHI(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNRHI(D0,0)),U)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I119(DFN,I,CNT) ;
+1 ;----- NAME field (#.01) of the PRIMARY CARE PROVIDER CHANGE LOG File (#9000096)
+2 ;
+3 DO HDR("I119",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNPRCL(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNPRCL(D0,0)),U)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I120(DFN,I,CNT) ;
+1 ;----- NAME field (#.01) of the OCCUPATIONAL HEALTH File (#9000097)
+2 ;
+3 DO HDR("I120",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^AUPNPOCC(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I121(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the PATIENT EXPOSURES File (#9000098)
+2 ;
+3 DO HDR("I121",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AUPNPEXP(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNPEXP(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I122(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.01) of the PCC DATA ENTRY DM UPDATE File (#9001002.2)
+2 ;
+3 DO HDR("I122",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^APCDDMUP(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^APCDDMUP(D0,0)),U)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I123(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.01) of the PATIENT sub-field (#9001500.01) of the REGISTER File (#9001500)
+2 ;
+3 DO HDR("I123",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^APCRREG(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 SET D1=0
+7 FOR
SET D1=$ORDER(^APCRREG(D0,1,D1))
IF 'D1
QUIT
Begin DoDot:2
+8 IF $PIECE($GET(^APCRREG(D0,1,D1,0)),U)'=DFN
QUIT
+9 WRITE !?5,D0,?15,D1,?25,DFN
+10 SET CNT=$GET(CNT)+1
End DoDot:2
End DoDot:1
+11 QUIT
I124(DFN,I,CNT) ;
+1 ;----- NAME field (#.01) of the DENTAL FOLLOWUP File (#9002003.2)
+2 ;
+3 DO HDR("I124",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ADEFOL(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ADEFOL(D0,0)),U)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I125(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.01) of the DENTAL DEFERRED SVCS REGISTER File (#9002003.4)
+2 ;
+3 DO HDR("I125",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^ADEDSR(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I126(DFN,I,CNT) ;
+1 ;----- NAME field (#.01) of the DENTAL PROCEDURE File (#9002007)
+2 ;
+3 DO HDR("I126",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ADEPCD(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ADEPCD(D0,0)),U)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I127(DFN,I,CNT) ;
+1 ;----- NAME field (#.01) of the DENTAL PATIENT File (#9002010.2)
+2 ;
+3 DO HDR("I127",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^ADEPAT(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I128(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.08) of the MHSS RECORD File (#9002011)
+2 ;
+3 DO HDR("I128",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMHREC(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMHREC(D0,0)),U,8)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I129(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the MHSS RECORD PROBLEMS (POVS) File (#9002011.01)
+2 ;
+3 DO HDR("I129",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMHRPRO(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMHRPRO(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I130(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the MHSS RECORD PROVIDERS File (#9002011.02)
+2 ;
+3 DO HDR("I130",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMHRPROV(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMHRPROV(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I131(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the MHSS RECORD TREATED MEDICAL PROBS File (#9002011.03)
+2 ;
+3 DO HDR("I131",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMHRTMDP(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMHRTMDP(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I132(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the MHSS RECORD PROCEDURES (CPT) File (#9002011.04)
+2 ;
+3 DO HDR("I132",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMHRPROC(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMHRPROC(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I133(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the MHSS RECORD PATIENT EDUCATION File (#9002011.05)
+2 ;
+3 DO HDR("I133",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMHREDU(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMHREDU(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I134(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the BH CD STAGING TOOL File (#9002011.06)
+2 ;
+3 DO HDR("I134",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMHRCDST(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMHRCDST(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I135(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.01) of the MHSS INTAKE File (#9002011.07)
+2 ;
+3 DO HDR("I135",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^AMHPINTK(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I136(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the MHSS RECORD HEALTH FACTORS File (#9002011.08)
+2 ;
+3 DO HDR("I136",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMHRHF(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMHRHF(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I137(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the MHSS RECORD PREVENTION ACTIVITES File (#9002011.09)
+2 ;
+3 DO HDR("I137",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMHRPA(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMHRPA(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I138(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the MHSS RECORD NAVAJO REFERRAL FORM File (#9002011.11)
+2 ;
+3 DO HDR("I138",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMHRNRF(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMHRNRF(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I139(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the MHSS PATIENT PROBLEM LIST File (#9002011.51)
+2 ;
+3 DO HDR("I139",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMHPPROB(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMHPPROB(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I140(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the MHSS PATIENT PERSONAL HX File (#9002011.52)
+2 ;
+3 DO HDR("I140",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMHPPHX(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMHPPHX(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I141(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the MHSS PATIENT TREATMENT NOTES File (#9002011.53)
+2 ;
+3 DO HDR("I141",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMHPTP(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMHPTP(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I142(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.01) of the MHSS PATIENT DATA File (#9002011.55)
+2 ;
+3 DO HDR("I142",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^AMHPATR(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I143(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the MHSS PATIENT TREATMENT PLANS File (#9002011.56)
+2 ;
+3 DO HDR("I143",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMHPTXP(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMHPTXP(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I144(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the *MHSS PATIENT TX PLAN METHODS File (#9002011.57)
+2 ;
+3 DO HDR("I144",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMHPTXPG(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMHPTXPG(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I145(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the MHSS CASE DATES File (#9002011.58)
+2 ;
+3 DO HDR("I145",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMHPCASE(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMHPCASE(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I146(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the *MHSS PATIENT TP PROBLEMS File (#9002011.62)
+2 ;
+3 DO HDR("I146",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMHPTPP(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMHPTPP(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I147(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the *MHSS PATIENT TP GOALS 2 File (#9002011.63)
+2 ;
+3 DO HDR("I147",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMHPTPGL(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMHPTPGL(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I148(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the *MHSS PATIENT TP METHODS File (#9002011.64)
+2 ;
+3 DO HDR("I148",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMHPTPM(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMHPTPM(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I149(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.04) of the MHSS SUICIDE FORMS File (#9002011.65)
+2 ;
+3 DO HDR("I149",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMHPSUIC(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMHPSUIC(D0,0)),U,4)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I150(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the CHEF NUMBER sub-field (#9002064.11) of the CHS CHEF REGISTRY File (#9002064.1)
+2 ;
+3 DO HDR("I150",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACHSCHEF(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 SET D1=0
+7 FOR
SET D1=$ORDER(^ACHSCHEF(D0,1,D1))
IF 'D1
QUIT
Begin DoDot:2
+8 IF $PIECE($GET(^ACHSCHEF(D0,1,D1,0)),U,2)'=DFN
QUIT
+9 WRITE !?5,D0,?15,D1,?25,DFN
+10 SET CNT=$GET(CNT)+1
End DoDot:2
End DoDot:1
+11 QUIT
I151(DFN,I,CNT) ;
+1 ;----- REGISTERED PATIENT field (#6) of the CHS DEFERRED SERVICE NUMBER sub-field (#9002066.01) of the CHS DEFERRED SERVICE DATA File (#9002066)
+2 ;
+3 DO HDR("I151",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACHSDEF(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 SET D1=0
+7 FOR
SET D1=$ORDER(^ACHSDEF(D0,"D",D1))
IF 'D1
QUIT
Begin DoDot:2
+8 IF $PIECE($GET(^ACHSDEF(D0,"D",D1,0)),U,6)'=DFN
QUIT
+9 WRITE !?5,D0,?15,D1,?25,DFN
+10 SET CNT=$GET(CNT)+1
End DoDot:2
End DoDot:1
+11 QUIT
I152(DFN,I,CNT) ;
+1 ;----- REGISTERED PATIENT field (#7) of the DENIAL NUMBER sub-field (#9002071.01) of the CHS DENIAL DATA File (#9002071)
+2 ;
+3 DO HDR("I152",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACHSDEN(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 SET D1=0
+7 FOR
SET D1=$ORDER(^ACHSDEN(D0,"D",D1))
IF 'D1
QUIT
Begin DoDot:2
+8 IF $PIECE($GET(^ACHSDEN(D0,"D",D1,0)),U,7)'=DFN
QUIT
+9 WRITE !?5,D0,?15,D1,?25,DFN
+10 SET CNT=$GET(CNT)+1
End DoDot:2
End DoDot:1
+11 QUIT
I153(DFN,I,CNT) ;
+1 ;----- PATIENT field (#13.64) of the DOCUMENT sub-field (#9002080.01) of the CHS FACILITY File (#9002080)
+2 ;
+3 DO HDR("I153",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACHSF(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 SET D1=0
+7 FOR
SET D1=$ORDER(^ACHSF(D0,"D",D1))
IF 'D1
QUIT
Begin DoDot:2
+8 IF $PIECE($GET(^ACHSF(D0,"D",D1,0)),U,22)'=DFN
QUIT
+9 WRITE !?5,D0,?15,D1,?25,DFN
+10 SET CNT=$GET(CNT)+1
End DoDot:2
End DoDot:1
+11 QUIT
I154(DFN,I,CNT) ;
+1 ;----- PATIENT field (#2) of the TRANSACTION RECORD sub-field (#9002080.02) of the DOCUMENT sub-field (#9002080.01) of the CHS FACILITY File (#9002080)
+2 ;
+3 DO HDR("I154",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACHSF(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 SET D1=0
+7 FOR
SET D1=$ORDER(^ACHSF(D0,"D",D1))
IF 'D1
QUIT
Begin DoDot:2
+8 SET D2=0
+9 FOR
SET D2=$ORDER(^ACHSF(D0,"D",D1,"T",D2))
IF 'D2
QUIT
Begin DoDot:3
+10 IF $PIECE($GET(^ACHSF(D0,"D",D1,"T",D2,0)),U,3)'=DFN
QUIT
+11 WRITE !?5,D0,?15,D1,?25,D2,?35,DFN
+12 SET CNT=$GET(CNT)+1
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
I155(DFN,I,CNT) ;
+1 ;----- NAME field (#.01) of the BI PATIENT File (#9002084)
+2 ;
+3 DO HDR("I155",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^BIP(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I156(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.01) of the BI PATIENT IMMUNIZATIONS DUE File (#9002084.1)
+2 ;
+3 DO HDR("I156",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^BIPDUE(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^BIPDUE(D0,0)),U)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I157(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.01) of the BI PATIENT CONTRAINDICATIONS File (#9002084.11)
+2 ;
+3 DO HDR("I157",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^BIPC(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^BIPC(D0,0)),U)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I158(DFN,I,CNT) ;
+1 ;----- NAME field (#.01) of the MCH PATIENT File (#9002085)
+2 ;
+3 DO HDR("I158",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^AMCH(85,D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I159(DFN,I,CNT) ;
+1 ;----- NAME field (#.01) of the BW PATIENT File (#9002086)
+2 ;
+3 DO HDR("I159",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^BWP(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I160(DFN,I,CNT) ;
+1 ;----- NAME field (#.02) of the QA CHS ADMISSION File (#9002157)
+2 ;
+3 DO HDR("I160",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AQACHSAD(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AQACHSAD(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I161(DFN,I,CNT) ;
+1 ;----- NAME field (#.02) of the QA IHS ADMISSION File (#9002159)
+2 ;
+3 DO HDR("I161",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AQACIHS(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AQACIHS(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I162(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.03) of the QI OCC CRITERIA File (#9002166.5)
+2 ;
+3 DO HDR("I162",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AQAOCC(5,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AQAOCC(5,D0,0)),U,3)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I163(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.03) of the QI OCC DRUG File (#9002166.6)
+2 ;
+3 DO HDR("I163",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AQAOCC(6,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AQAOCC(6,D0,0)),U,3)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I164(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.03) of the QI OCC PROVIDER File (#9002166.7)
+2 ;
+3 DO HDR("I164",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AQAOCC(7,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AQAOCC(7,D0,0)),U,3)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I165(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.03) of the QI OCC DIAGNOSIS File (#9002166.8)
+2 ;
+3 DO HDR("I165",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AQAOCC(8,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AQAOCC(8,D0,0)),U,3)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I166(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.03) of the QI OCC PROCEDURE File (#9002166.9)
+2 ;
+3 DO HDR("I166",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AQAOCC(9,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AQAOCC(9,D0,0)),U,3)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I167(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.02) of the QI OCCURRENCE File (#9002167)
+2 ;
+3 DO HDR("I167",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AQAOC(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AQAOC(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I168(DFN,I,CNT) ;
+1 ;----- CLIENTS NAME field (#4) of the CDMIS VISIT File (#9002172.1)
+2 ;
+3 DO HDR("I168",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACDVIS(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ACDVIS(D0,0)),U,5)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I169(DFN,I,CNT) ;
+1 ;----- CLIENT field (#.01) of the CLIENT sub-field (#9002172.81) of the CDMIS CLIENT CATEGORY File (#9002172.8)
+2 ;
+3 DO HDR("I169",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACDPAT(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 ;DINUMED
SET D1=DFN
+7 IF '$DATA(^ACDPAT(D0,1,D1))
QUIT
+8 WRITE ?5,D0,?15,D1,?25,DFN
+9 SET CNT=$GET(CNT)+1
End DoDot:1
+10 QUIT
I170(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the CDMIS BILL File (#9002172.9
+2 ;
+3 DO HDR("I170",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACDBILL(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ACDBILL(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I171(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.01) of the PATIENT sub-field (#9002227.01101) of the PT TAXONOMY File (#9002227)
+2 ;
+3 DO HDR("I171",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ATXPAT(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 ;DINUMED
SET D1=DFN
+7 IF '$DATA(^ATXPAT(D0,11,D1))
QUIT
+8 WRITE ?5,D0,?15,D1,?25,DFN
+9 SET CNT=$GET(CNT)+1
End DoDot:1
+10 QUIT
I172(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the CIC VISIT File (#9002230)
+2 ;
+3 DO HDR("I172",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACI(30,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ACI(30,D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I173(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the CMS REGISTER File (#9002241)
+2 ;
+3 DO HDR("I173",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACM(41,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ACM(41,D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I174(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the CMS COMPLICATION FOR THE CLIENT File (#9002242)
+2 ;
+3 DO HDR("I174",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACM(42,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ACM(42,D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I175(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the CMS INTERVENTION PLAN File (#9002243)
+2 ;
+3 DO HDR("I175",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACM(43,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ACM(43,D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I176(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the CMS DIAGNOSIS FOR THE CLIENT File (#9002244)
+2 ;
+3 DO HDR("I176",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACM(44,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ACM(44,D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I177(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the CMS RISK FACTOR FOR THE CLIENT File (#9002245)
+2 ;
+3 DO HDR("I177",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACM(45,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ACM(45,D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I178(DFN,I,CNT) ;
+1 ;----- FAMILY MEMBER field (#.01) of the CMS FAMILY MEMBERS File (#9002246)
+2 ;
+3 DO HDR("I178",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACM(46,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ACM(46,D0,0)),U)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I179(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the CMS FAMILY MEMBERS File (#9002246)
+2 ;
+3 DO HDR("I179",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACM(46,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ACM(46,D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I180(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the CMS SERVICE FOR THE CLIENT File (#9002247)
+2 ;
+3 DO HDR("I180",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACM(47,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ACM(47,D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I181(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the CMS CARE PLAN FOR THE CLIENT File (#9002248)
+2 ;
+3 DO HDR("I181",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACM(48,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ACM(48,D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I182(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the CMS APPOINTMENT File (#9002249)
+2 ;
+3 DO HDR("I182",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACM(49,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ACM(49,D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I183(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the CMS REGISTER CRITERIA FOR THE CLIENT File (#9002251)
+2 ;
+3 DO HDR("I183",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACM(51,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ACM(51,D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I184(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the CMS ETIOLOGY FOR THIS CLIENT File (#9002253)
+2 ;
+3 DO HDR("I184",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACM(53,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ACM(53,D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I185(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the CMS MEDICATIONS FOR THE CLIENT File (#9002254)
+2 ;
+3 DO HDR("I185",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACM(54,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ACM(54,D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I186(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the CMS MEASUREMENT File (#9002257)
+2 ;
+3 DO HDR("I186",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ACM(57,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ACM(57,D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I187(DFN,I,CNT) ;
+1 ;----- PATIENT'S NAME field (#1) of the PRIVATE INS FACILITY BILLING File (#9002273.02)
+2 ;
+3 DO HDR("I187",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ABPVFAC(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ABPVFAC(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I188(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.01) of the 3P CLAIM DATA File (#9002274.3)
+2 ;
+3 DO HDR("I188",I)
+4 SET DUZ2=0
+5 FOR
SET DUZ2=$ORDER(^ABMDCLM(DUZ2))
IF 'DUZ2
QUIT
Begin DoDot:1
+6 SET D0=0
+7 FOR
SET D0=$ORDER(^ABMDCLM(DUZ2,D0))
IF 'D0
QUIT
Begin DoDot:2
+8 IF $PIECE($GET(^ABMDCLM(DUZ2,D0,0)),U)'=DFN
QUIT
+9 WRITE !?5,DUZ2,?15,D0,?25,DFN
+10 SET CNT=$GET(CNT)+1
End DoDot:2
End DoDot:1
+11 QUIT
I189(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.05) of the 3P BILL File (#9002274.4)
+2 ;
+3 DO HDR("I189",I)
+4 SET DUZ2=0
+5 FOR
SET DUZ2=$ORDER(^ABMDBILL(DUZ2))
IF 'DUZ2
QUIT
Begin DoDot:1
+6 SET D0=0
+7 FOR
SET D0=$ORDER(^ABMDBILL(DUZ2,D0))
IF 'D0
QUIT
Begin DoDot:2
+8 IF $PIECE($GET(^ABMDBILL(DUZ2,D0,0)),U,5)'=DFN
QUIT
+9 WRITE !?5,DUZ2,?15,D0,?25,DFN
+10 SET CNT=$GET(CNT)+1
End DoDot:2
End DoDot:1
+11 QUIT
I190(DFN,I,CNT) ;
+1 ;----- PATIENT field (#5) of the ABSP LOG OF TRANSACTIONS File (#9002313.57)
+2 ;
+3 DO HDR("I190",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ABSPTL(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ABSPTL(D0,0)),U,6)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I191(DFN,I,CNT) ;
+1 ;----- PATIENT field (#5) of the ABSP TRANSACTION File (#9002313.59)
+2 ;
+3 DO HDR("I191",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ABSPT(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ABSPT(D0,0)),U,6)'=DFN
QUIT
+7 WRITE !?5,D0," ",DFN
+8 SET CNT=$GET(CNT)+1
End DoDot:1
+9 QUIT
I192(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.01) of the DAY SURGERY File (#9009012)
+2 ;
+3 DO HDR("I192",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^ADGDS(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I193(DFN,I,CNT) ;
+1 ;----- NAME field (#.01) of the DS INCOMPLETE CHART File (#9009012.5)
+2 ;
+3 DO HDR("I193",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^ADGDSI(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I194(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.01) of the INCOMPLETE CHART File (#9009013)
+2 ;
+3 DO HDR("I194",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^ADGIC(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I195(DFN,I,CNT) ;
+1 ;----- NAME field (#.01) of the SCHEDULED VISIT File (#9009013.1)
+2 ;
+3 DO HDR("I195",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^ADGAUTH(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I196(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.01) of the PATIENT sub-field (#9009015.01) of the WAITING LIST CLINIC File (#9009015)
+2 ;
+3 DO HDR("I196",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ASDWL(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 SET D1=0
+7 FOR
SET D1=$ORDER(^ASDWL(D0,1,D1))
IF 'D1
QUIT
Begin DoDot:2
+8 IF $PIECE($GET(^ASDWL(D0,1,D1,0)),U)'=DFN
QUIT
+9 WRITE !?5,D0,?15,D1,?25,DFN
+10 SET CNT=$GET(CNT)+1
End DoDot:2
End DoDot:1
+11 QUIT
I197(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.04) of the BLRA LAB AUDIT File (#9009027)
+2 ;
+3 DO HDR("I197",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^BLRALAB(9009027,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^BLRALAB(9009027,D0,0)),U,4)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I198(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.04) of the APSP DUE REVIEW File (#9009032)
+2 ;
+3 DO HDR("I198",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^APSPDUE(32,D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^APSPDUE(32,D0,0)),U,4)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I199(DFN,I,CNT) ;
+1 ;----- PATIENT field (#2) of the NON FORMULARY REQUESTS File (#9009035.1)
+2 ;
+3 DO HDR("I199",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^APSQNF(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^APSQNF(D0,0)),U,3)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I200(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.04) of the ANS NURSE ACUITY RECORD File (#9009052)
+2 ;
+3 DO HDR("I200",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^ANSR(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ANSR(D0,0)),U,4)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I201(DFN,I,CNT) ;
+1 ;----- PATIENTS ADDED field (#.01) of the PATIENTS ADDED sub-field (#9009062.021) of the AG ELIGIBILITY UPLOAD LOG File (#9009062.02)
+2 ;
+3 DO HDR("I201",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AGELUPLG(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 ;DINUMED
SET D1=DFN
+7 IF '$DATA(^AGELUPLG(D0,1,D1))
QUIT
+8 WRITE !?5,D0,?15,D1,?25,DFN
+9 SET CNT=$GET(CNT)+1
End DoDot:1
+10 QUIT
I202(DFN,I,CNT) ;
+1 ;----- PATIENTS EDITED field (#.01) of the PATIENTS EDITED sub-field (#9009062.022) of the AG ELIGIBILITY UPLOAD LOG File (#9009062.02)
+2 ;
+3 DO HDR("I202",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AGELUPLG(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 ;DINUMED
SET D1=DFN
+7 IF '$DATA(^AGELUPLG(D0,2,D1))
QUIT
+8 WRITE !?5,D0,?15,D1,?25,DFN
+9 SET CNT=$GET(CNT)+1
End DoDot:1
+10 QUIT
I203(DFN,I,CNT) ;
+1 ;----- NAME field (#.01) of the AGVQ VERIQUEST PATIENT File (#9009062.08)
+2 ;
+3 DO HDR("I203",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^AGVQP(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
I204(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the AG MESSAGE TRANSACTIONS File (#9009063.1)
+2 ;
+3 DO HDR("I204",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AGTXMSG(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AGTXMSG(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I205(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.01) of the PATIENT sub-field (#9009065.05) of the REGISTRATION MAILING LIST File (#9009065)
+2 ;
+3 DO HDR("I205",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AGADLIST(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 SET D1=0
+7 FOR
SET D1=$ORDER(^AGADLIST(D0,1,D1))
IF 'D1
QUIT
Begin DoDot:2
+8 IF $PIECE($GET(^AGADLIST(D0,1,D1,0)),U)'=DFN
QUIT
+9 WRITE !?5,D0,?15,D1,?25,DFN
+10 SET CNT=$GET(CNT)+1
End DoDot:2
End DoDot:1
+11 QUIT
I206(DFN,I,CNT) ;
+1 ;----- PATIENT NAME field (#.01) of the AGEV INSURANCE ELIGIBILITY HOLDING File (#9009066)
+2 ;
+3 DO HDR("I206",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AGEVH(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AGEVH(D0,0)),U)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I207(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.02) of the ER VISIT File (#9009080)
+2 ;
+3 DO HDR("I207",I)
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^AMERVSIT(D0))
IF 'D0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AMERVSIT(D0,0)),U,2)'=DFN
QUIT
+7 DO WRITE(D0,DFN,.CNT)
End DoDot:1
+8 QUIT
I208(DFN,I,CNT) ;
+1 ;----- PATIENT field (#.01) of the ER ADMISSION File (#9009081)
+2 ;
+3 DO HDR("I208",I)
+4 ;DINUMED
SET D0=DFN
+5 IF '$DATA(^AMERADM(D0))
QUIT
+6 DO WRITE(D0,DFN,.CNT)
+7 QUIT
HDR(X,I) ;
+1 ;----- WRITE HEADER
+2 ;
+3 WRITE !!,I," ",$TEXT(@(X)+1),!
+4 QUIT
WRITE(D0,X,CNT) ;
+1 ;----- WRITE FINDINGS
+2 ;
+3 WRITE !?5,D0,?15,X
+4 SET CNT=$GET(CNT)+1
+5 QUIT
QUE(DFN) ;
+1 ;
+2 NEW %ZIS,POP,ZTDESC,ZTIO,ZTRTN,ZTSAVE
+3 ;
+4 SET ZTSAVE("DFN")=""
+5 SET ZTRTN="DQ^AZAXDPM1"
+6 SET ZTDESC="FIND 'IHS' PATIENT FILE POINTERS"
+7 ;
+8 SET %ZIS="Q"
+9 DO ^%ZIS
+10 IF POP
QUIT
+11 IF $DATA(IO("Q"))
Begin DoDot:1
+12 KILL IO("Q")
+13 SET ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
+14 DO ^%ZTLOAD
+15 WRITE !,"Task #",$GET(ZTSK)," queued"
End DoDot:1
QUIT
+16 DO @ZTRTN
+17 QUIT
