Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AZAXDPM2

AZAXDPM2.m

Go to the documentation of this file. 
  1. AZAXDPM2 ;IHS/PHXAO/AEF - FIND VA PATIENT FILE POINTERS FOR PATIENT MERGE PROCESS
  1.  ;;1.0;ANNE'S SPECIAL ROUTINES;;AUG 23, 2004
  1.  ;;
  1.  ;;THIS ROUTINE SEARCHES EACH POINTER TO THE VA PATIENT FILE FOR THE
  1.  ;;SPECIFIED POINTER VALUE
  1.  ;;
  1. EN ;EP -- MAIN ENTRY POINT
  1.  ;
  1.  N DFN,Y
  1.  ;
  1.  D ^XBKVAR
  1.  D HOME^%ZIS
  1.  ;
  1.  D SEL(.Y)
  1.  Q:Y'>0
  1.  S DFN=+Y
  1.  ;
  1.  D QUE(DFN)
  1.  ;
  1.  Q
  1. SEL(DFN) ;
  1.  ;----- SELECT DFN TO SEARCH FOR
  1.  ;
  1.  N DIR,X
  1.  S DIR(0)="N"
  1.  S DIR("A")="Select DFN to search for"
  1.  D ^DIR
  1.  Q +Y
  1. DQ ;EP -- QUEUED JOB STARTS HERE
  1.  ;
  1.  D PRT(DFN)
  1.  D ^%ZISC
  1.  Q
  1. PRT(DFN) ;
  1.  ;----- PRINT THE REPORT
  1.  ;
  1.  N CNT,D0,D1,D2,DUZ2,I,ROU,X
  1.  W @IOF
  1.  W !,"FINDING 'VA PATIENT' FILE POINTERS FOR PATIENT ",$P($G(^DPT(DFN,0)),U),"    DFN #",DFN,!
  1.  S CNT=0
  1.  F I=1:1:60 D
  1.  . S ROU="V"_I_"("_DFN_","_I_","_".CNT"_")"
  1.  . D @ROU
  1.  ;
  1.  W !!,CNT," POINTERS FOUND",!
  1.  Q
  1. V1(DFN,I,CNT) ;
  1.  ;----- MERGED TO PATIENT field (#.082) of the VA PATIENT File (#2)
  1.  ;
  1.  D HDR("V1",I)
  1.  W !?5,"<NOT APPLICABLE>"
  1.  Q
  1. V2(DFN,I,CNT) ;
  1.  ;----- COLLATERAL SPONSOR'S NAME field (#.3601) of the VA PATIENT File (#2)
  1.  ;
  1.  D HDR("V2",I)
  1.  S D0=0
  1.  F  S D0=$O(^DPT(D0)) Q:'D0  D
  1.  . Q:$P($G(^DPT(D0,.36)),U,11)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V3(DFN,I,CNT) ;
  1.  ;----- RECORD1 field (#.01) of the DUPLICATE RECORD File (#15)
  1.  ;
  1.  D HDR("V3",I)
  1.  W !?5,"<NOT APPLICABLE>"
  1.  Q
  1. V4(DFN,I,CNT) ;
  1.  ;----- RECORD2 field (#.02) of the DUPLICATE RECORD File (#15)
  1.  ;
  1.  D HDR("V4",I)
  1.  W !?5,"<NOT APPLICABLE>"
  1.  Q
  1. V5(DFN,I,CNT) ;
  1.  ;----- MFI PATIENT field (#999999903) of the DUPLICATE RECORD File (#15)
  1.  ;
  1.  D HDR("V5",I)
  1.  W !?5,"<NOT APPLICABLE>"
  1.  Q
  1. V6(DFN,I,CNT) ;
  1.  ;----- MERGED FROM field (#.01) of the MERGE IMAGES File (#15.4)
  1.  ;
  1.  D HDR("V6",I)
  1.  W !?5,"<NOT APPLICABLE>"
  1.  Q
  1. V7(DFN,I,CNT) ;
  1.  ;----- MERGED TO field (#.02) of the MERGE IMAGES File (#15.4)
  1.  ;
  1.  D HDR("V7",I)
  1.  W !?5,"<NOT APPLICABLE>"
  1.  Q
  1. V8(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#.01) of the SCHEDULED ADMISSION File (#41.1)
  1.  ;
  1.  D HDR("V8",I)
  1.  S D0=0
  1.  F  S D0=$O(^DGS(41.1,D0)) Q:'D0  D
  1.  . Q:$P($G(^DGS(41.1,D0,0)),U)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V9(DFN,I,CNT) ;
  1.  ;----- *SCHEDULED ADMISSION PATIENT field (#.01) of the *SCHEDULED ADMISSION PATIENT sub-field (#42.182) of the WARD LOCATION File (#42)
  1.  ;
  1.  D HDR("V9",I)
  1.  S D0=0
  1.  F  S D0=$O(^DIC(42,D0)) Q:'D0  D
  1.  . S D1=DFN   ;DINUMED
  1.  . Q:'$D(^DIC(42,D0,"RSV",D1))
  1.  . W !?5,D0,?15,D1,?25,DFN
  1.  . S CNT=$G(CNT)+1
  1.  Q
  1. V10(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#.05) of the G&L CORRECTIONS File (#43.5)
  1.  ;
  1.  D HDR("V10",I)
  1.  S D0=0
  1.  F  S D0=$O(^DGS(43.5,D0)) Q:'D0  D
  1.  . Q:$P($G(^DGS(43.5,D0,0)),U,5)'=DFN
  1.  . W !?5,D0,"   ",DFN
  1.  . S CNT=$G(CNT)+1
  1.  Q
  1. V11(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#.01) of the PATIENT sub-field (#44.003) of the APPOINTMENT sub-field (#44.001) of the HOSPITAL LOCATION File (#44)
  1.  ;
  1.  D HDR("V11",I)
  1.  S D0=0
  1.  F  S D0=$O(^SC(D0)) Q:'D0  D
  1.  . S D1=0
  1.  . F  S D1=$O(^SC(D0,"S",D1)) Q:'D1  D
  1.  . . S D2=0
  1.  . . F  S D2=$O(^SC(D0,"S",D1,1,D2)) Q:'D2  D
  1.  . . . Q:$P($G(^SC(D0,"S",D1,1,D2,0)),U)'=DFN
  1.  . . . W !?5,D0,?15,D1,?25,D2,?35,DFN
  1.  . . . S CNT=$G(CNT)+1
  1.  Q
  1. V12(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#.01) of the PATIENT sub-field (#44.007) of the CHART CHECK sub-field (#44.006) of the HOSPITAL LOCATION File (#44)
  1.  ;
  1.  D HDR("V12",I)
  1.  S D0=0
  1.  F  S D0=$O(^SC(D0)) Q:'D0  D
  1.  . S D1=0
  1.  . F  S D1=$O(^SC(D0,"C",D1)) Q:'D1  D
  1.  . . S D2=0
  1.  . . F  S D2=$O(^SC(D0,"C",D1,1,D2)) Q:'D2  D
  1.  . . . Q:$P($G(^SC(D0,"C",D1,1,D2,0)),U)'=DFN
  1.  . . . W !?5,D0,?15,D1,?25,D2,?35,DFN
  1.  . . . S CNT=$G(CNT)+1
  1.  Q
  1. V13(DFN,I,CNT) ;
  1.  ;----- NAME field (#.01) of the CENSUS WORKFILE File (#45.85)
  1.  ;
  1.  D HDR("V13",I)
  1.  S D0=0
  1.  F  S D0=$O(^DG(45.85,D0)) Q:'D0  D
  1.  . Q:$P($G(^DG(45.85,D0,0)),U)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V14(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#7) of the DUE ANSWER SHEET File (#50.0731)
  1.  ;
  1.  D HDR("V14",I)
  1.  S D0=0
  1.  F  S D0=$O(^PS(50.0731,D0)) Q:'D0  D
  1.  . Q:$P($G(^PS(50.0731,D0,0)),U,8)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V15(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#.01) of the PATIENT sub-field (#50.801) of the IV STATS File (#50.8)
  1.  ;
  1.  D HDR("V15",I)
  1.  S D0=0
  1.  F  S D0=$O(^PS(50.8,D0))  Q:'D0  D
  1.  . S D1=0
  1.  . F  S D1=$O(^PS(50.8,D0,1,D1)) Q:'D1  D
  1.  . . Q:$P($G(^PS(50.8,D0,1,D1,0)),U)'=DFN
  1.  . . W !?5,D0,?15,D1,?25,DFN
  1.  . . S CNT=$G(CNT)+1
  1.  Q
  1. V16(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#.01) of the PATIENT sub-field (#50.806) of the IV DRUG sub-field (#50.805) of the DATE sub-field (#50.803) of the IV STATS File (#50.8)
  1.  ;
  1.  D HDR("V16",I)
  1.  S D0=0
  1.  F  S D0=$O(^PS(50.8,D0)) Q:'D0  D
  1.  . S D1=0
  1.  . F  S D1=$O(^PS(50.8,D0,2,D1)) Q:'D1  D
  1.  . . S D2=0
  1.  . . F  S D2=$O(^PS(50.8,D0,2,D1,2,D2)) Q:'D2  D
  1.  . . . S D3=DFN   ;DINUMED
  1.  . . . Q:'$D(^PS(50.8,D0,2,D1,2,D2,1,D3))
  1.  . . . W !?5,D0,?15,D1,?25,D2,?35,D3,?45,DFN
  1.  . . . S CNT=$G(CNT)+1
  1.  Q
  1. V17(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#2) of the PRESCRIPTION File (#52)
  1.  ;
  1.  D HDR("V17",I)
  1.  S D0=0
  1.  F  S D0=$O(^PSRX(D0)) Q:'D0  D
  1.  . Q:$P($G(^PSRX(D0,0)),U,2)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V18(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#.01) of the PATIENT NOTIFICATION (Rx READY) File (#52.11)
  1.  ;
  1.  D HDR("V18",I)
  1.  S D0=0
  1.  F  S D0=$O(^PS(52.11,D0)) Q:'D0  D
  1.  . Q:$P($G(^PS(52.11,D0,0)),U)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V19(DFN,I,CNT) ;
  1.  ;----- PATIENT NAME field (#1) of the RX VERIFY File (#52.4)
  1.  ;
  1.  D HDR("V19",I)
  1.  S D0=0
  1.  F  S D0=$O(^PS(52.4,D0)) Q:'D0  D
  1.  . Q:$P($G(^PS(52.4,D0,0)),U,2)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V20(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#1) of the *REFILL WITH NON VERIFIED NEWS File (#52.41)
  1.  ;
  1.  D HDR("V20",I)
  1.  S D0=0
  1.  F  S D0=$O(^PS(52.41,D0)) Q:'D0  D
  1.  . Q:$P($G(^PS(52.41,D0,0)),U,2)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V21(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#.03) of the RX SUSPENSE File (#52.5)
  1.  ;
  1.  D HDR("V21",I)
  1.  S D0=0
  1.  F  S D0=$O(^PS(52.5,D0)) Q:'D0  D
  1.  . Q:$P($G(^PS(52.5,D0,0)),U,3)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V22(DFN,I,CNT) ;
  1.  ;----- PATIENT # field (#1) of the PHARMACY ARCHIVE File (#52.8)
  1.  ;
  1.  D HDR("V22",I)
  1.  S D0=0
  1.  F  S D0=$O(^PSOARC(D0)) Q:'D0  D
  1.  . Q:$P($G(^PSOARC(D0,0)),U,2)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V23(DFN,I,CNT) ;
  1.  ;----- PATIENT NAME field (#.01) of the LABEL/PROFILE sub-field (#52.9001) of the PHARMACY PRINTED QUEUE File (#52.9)
  1.  ;
  1.  D HDR("V23",I)
  1.  S D0=0
  1.  F  S D0=$O(^PS(52.9,D0)) Q:'D0  D
  1.  . S D1=0
  1.  . F  S D1=$O(^PS(52.9,D0,1,D1)) Q:'D1  D
  1.  . . Q:$P($G(^PS(52.9,D0,1,D1,0)),U)'=DFN
  1.  . . W !?5,D0,?15,D1,?25,DFN
  1.  . . S CNT=$G(CNT)+1
  1.  Q
  1. V24(DFN,I,CNT) ;
  1.  ;----- PATIENT NAME field (#.5) of the NON-VERIFIED ORDERS File (#53.1)
  1.  ;
  1.  D HDR("V24",I)
  1.  S D0=0
  1.  F  S D0=$O(^PS(53.1,D0)) Q:'D0  D
  1.  . Q:$P($G(^PS(53.1,D0,0)),U,15)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V25(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#.01) of the PATIENT sub-field (#53.401) of the PRE-EXCHANGE NEEDS File (#53.4)
  1.  ;
  1.  D HDR("V25",I)
  1.  S D0=0
  1.  F  S D0=$O(^PS(53.4,D0)) Q:'D0  D
  1.  . S D1=DFN   ;DINUMED
  1.  . Q:'$D(^PS(53.4,D0,1,D1))
  1.  . W !?5,D0,?15,D1,?25,DFN
  1.  . S CNT=$G(CNT)+1
  1.  Q
  1. V26(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#.01) of the PATIENT sub-field (#53.4102) of the USER OR WARD sub-field (#53.4101) of the UNIT DOSE LABELS File (#53.41)
  1.  ;
  1.  D HDR("V26",I)
  1.  S D0=0
  1.  F  S D0=$O(^PS(53.41,D0)) Q:'D0  D
  1.  . S D1=0
  1.  . F  S D1=$O(^PS(53.41,D0,1,D1)) Q:'D1  D
  1.  . . S D2=DFN   ;DINUMED
  1.  . . Q:'$D(^PS(53.41,D0,1,D1,1,D2))
  1.  . . W !?5,D0,?15,D1,?25,D2,?35,DFN
  1.  . . S CNT=$G(CNT)+1
  1.  Q
  1. V27(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#.01) of the PATIENT sub-field (#53.43011) of the REPORT NUMBER sub-field (#53.4301) of the MISCELLANEOUS REPORT FILE File (#53.43)
  1.  ;
  1.  D HDR("V27",I)
  1.  S D0=0
  1.  F  S D0=$O(^PS(53.43,D0)) Q:'D0  D
  1.  . S D1=0
  1.  . F  S D1=$O(^PS(53.43,D0,1,D1)) Q:'D1  D
  1.  . . S D2=DFN   ;DINUMED
  1.  . . Q:'$D(^PS(53.43,D0,1,D1,1,D2))
  1.  . . W !?5,D0,?15,D1,?25,D2,?35,DFN
  1.  . . S CNT=$G(CNT)+1
  1.  Q
  1. V28(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#.01) of the PATIENT sub-field (#53.4401) of the PHYSICIANS' ORDERS File (#53.44)
  1.  ;
  1.  D HDR("V28",I)
  1.  S D0=0
  1.  F  S D0=$O(^PS(53.44,D0)) Q:'D0  D
  1.  . S D1=DFN   ;DINUMED
  1.  . Q:'$D(^PS(53.44,D0,1,D1))
  1.  . W !?5,D0,?15,D1,?25,DFN
  1.  . S CNT=$G(CNT)+1
  1.  Q
  1. V29(DFN,I,CNT) ;
  1.  ;----- NAME field (#.01) of the PHARMACY PATIENT File (#55)
  1.  ;
  1.  D HDR("V29",I)
  1.  S D0=DFN   ;DINUMED
  1.  Q:'$D(^PS(55,D0))
  1.  D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V30(DFN,I,CNT) ;
  1.  ;----- PATIENT NAME field (#.5) of the UNIT DOSE sub-field (#55.06) of the PHARMACY PATIENT File (#55)
  1.  ;
  1.  D HDR("V30",I)
  1.  S D0=0
  1.  F  S D0=$O(^PS(55,D0)) Q:'D0  D
  1.  . S D1=0
  1.  . F  S D1=$O(^PS(55,D0,5,D1)) Q:'D1  D
  1.  . . Q:$P($G(^PS(55,D0,5,D1,0)),U,15)'=DFN
  1.  . . W !?5,D0,?15,D1,?25,DFN
  1.  . . S CNT=$G(CNT)+1
  1.  Q
  1. V31(DFN,I,CNT) ;
  1.  ;----- PATIENT NAME field (#2) of the WKLD LOG FILE File (#64.03)
  1.  ;
  1.  D HDR("V31",I)
  1.  S D0=0
  1.  F  S D0=$O(^LRO(64.03,D0)) Q:'D0  D
  1.  . S X=$P($G(^LRO(64.03,D0,0)),U,3)   ;VARIABLE POINTER
  1.  . Q:+X'=DFN
  1.  . Q:$P(X,";",2)'="DPT("
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V32(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#9) of the ACCESSION WKLD CODE TIME sub-field (#64.1111) of the WKLD CODE sub-field (#64.111) of the DATE sub-field (#64.11) of the WKLD DATA File (#64.1)
  1.  ;
  1.  D HDR("V32",I)
  1.  S D0=0
  1.  F  S D0=$O(^LRO(64.1,D0)) Q:'D0  D
  1.  . S D1=0
  1.  . F  S D1=$O(^LRO(64.1,D0,1,D1)) Q:'D1  D
  1.  . . S D2=0
  1.  . . F  S D2=$O(^LRO(64.1,D0,1,D1,1,D2)) Q:'D2  D
  1.  . . . S D3=0
  1.  . . . F  S D3=$O(^LRO(64.1,D0,1,D1,1,D2,1,D3)) Q:'D3  D
  1.  . . . . S X=$P($G(^LRO(64.1,D0,1,D1,1,D2,1,D3,0)),U,10)   ;VARIABLE POINTER
  1.  . . . . Q:+X'=DFN
  1.  . . . . Q:$P(X,";",2)'="DPT("
  1.  . . . . W !?5,D0,?15,D1,?25,D2,?35,D3,?45,DFN
  1.  . . . . S CNT=$G(CNT)+1
  1.  Q
  1. V33(DFN,I,CNT) ;
  1.  ;----- VA PATIENT NUMBER field (#.07) of the DATE/TIME UNIT RELOCATION sub-field (#65.03) of the BLOOD INVENTORY File (#65)
  1.  ;
  1.  D HDR("V33",I)
  1.  S D0=0
  1.  F  S D0=$O(^LRD(65,D0)) Q:'D0  D
  1.  . S D1=0
  1.  . F  S D1=$O(^LRD(65,D0,3,D1)) Q:'D1  D
  1.  . . Q:$P($G(^LRD(65,D0,3,D1,0)),U,7)'=DFN
  1.  . . W !?5,D0,?15,D1,?25,DFN
  1.  . . S CNT=$G(CNT)+1
  1.  Q
  1. V34(DFN,I,CNT) ;
  1.  ;----- PATIENT FILE REF field (#2) of the REFERRAL PATIENT File (#67)
  1.  ;
  1.  D HDR("V34",I)
  1.  S D0=0
  1.  F  S D0=$O(^LRT(67,D0)) Q:'D0  D
  1.  . Q:$P($G(^LRT(67,D0,"DPT")),U)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V35(DFN,I,CNT) ;
  1.  ;----- Patient Name field (#3) of the REFERRAL PATIENT File (#67)
  1.  ;
  1.  D HDR("V35",I)
  1.  S D0=0
  1.  F  S D0=$O(^LRT(67,D0)) Q:'D0  D
  1.  . S X=$P($G(^LRT(67,D0,3)),U)   ;VARIABLE POINTER
  1.  . Q:+X'=DFN
  1.  . Q:$P(X,";",2)'="DPT("
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V36(DFN,I,CNT) ;
  1.  ;----- VA PATIENT NUMBER field (#.06) of the LRDFN sub-field (#69.3) of the USER REQUEST LIST sub-field (#69.28) of the LAB SECTION PRINT File (#69.2)
  1.  ;
  1.  D HDR("V36",I)
  1.  S D0=0
  1.  F  S D0=$O(^LRO(69.2,D0)) Q:'D0  D
  1.  . S D1=0
  1.  . F  S D1=$O(^LRO(69.2,D0,7,D1)) Q:'D1  D
  1.  . . S D2=0
  1.  . . F  S D2=$O(^LRO(69.2,D0,7,D1,1,D2)) Q:'D2  D
  1.  . . . Q:$P($G(^LRO(69.2,D0,7,D1,1,D2,0)),U,6)'=DFN
  1.  . . . W !?5,D0,?15,D1,?25,D2,?35,DFN
  1.  . . . S CNT=$G(CNT)+1
  1.  Q
  1. V37(DFN,I,CNT) ;
  1.  ;----- NAME field (#.01) of the RADIOLOGY PATIENT File (#70)
  1.  ;
  1.  D HDR("V37",I)
  1.  S D0=DFN   ;DINUMED
  1.  Q:'$D(^RADPT(D0))
  1.  D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V38(DFN,I,CNT) ;
  1.  ;----- PATIENT NAME field (#2) of the RADIOLOGY REPORTS File (#74)
  1.  ;
  1.  D HDR("V38",I)
  1.  S D0=0
  1.  F  S D0=$O(^RARPT(D0)) Q:'D0  D
  1.  . Q:$P($G(^RARPT(D0,0)),U,2)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V39(DFN,I,CNT) ;
  1.  ;----- *PATIENT field (#9) of the REPORT DISTRIBUTION File (#74.4)
  1.  ;
  1.  D HDR("V39",I)
  1.  S D0=0
  1.  F  S D0=$O(^RABTCH(74.4,D0)) Q:'D0  D
  1.  . Q:$P($G(^RABTCH(74.4,D0,0)),U,9)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V40(DFN,I,CNT) ;
  1.  ;----- NAME field (#.01) of the RADIOLOGY ORDERS File (#75.1)
  1.  ;
  1.  D HDR("V40",I)
  1.  S D0=0
  1.  F  S D0=$O(^RAO(75.1,D0)) Q:'D0  D
  1.  . Q:$P($G(^RAO(75.1,D0,0)),U)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V41(DFN,I,CNT) ;
  1.  ;----- OBJECT OF ORDER field (#.02) of the ORDER File (#100)
  1.  ;
  1.  D HDR("V41",I)
  1.  S D0=0
  1.  F  S D0=$O(^OR(100,D0)) Q:'D0  D
  1.  . S X=$P($G(^OR(100,D0,0)),U,2)   ;VARIABLE POINTER
  1.  . Q:+X'=DFN
  1.  . Q:$P(X,";",2)'="DPT("
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V42(DFN,I,CNT) ;
  1.  ;----- NAME field (#.01) of the OE/RR PATIENT File (#100.2)
  1.  ;
  1.  D HDR("V42",I)
  1.  S D0=DFN   ;DINUMED
  1.  Q:'$D(^OR(100.2,D0))
  1.  D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V43(DFN,I,CNT) ;
  1.  ;----- MEMBER field (#.01) of the MEMBER sub-field (#100.2101) of the OE/RR LIST File (#100.21)
  1.  ;
  1.  D HDR("V43",I)
  1.  S D0=0
  1.  F  S D0=$O(^OR(100.21,D0)) Q:'D0  D
  1.  . S D1=0
  1.  . F  S D1=$O(^OR(100.21,D0,10,D1)) Q:'D1  D
  1.  . . S X=$P($G(^OR(100.21,D0,10,D1,0)),U)   ;VARIABLE POINTER
  1.  . . Q:+X'=DFN
  1.  . . Q:$P(X,";",2)'="DPT("
  1.  . . W !?5,D0,?15,D1,?25,DFN
  1.  . . S CNT=$G(CNT)+1
  1.  Q
  1. V44(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#.01) of the PATIENT ALLERGIES File (#120.8)
  1.  ;
  1.  D HDR("V44",I)
  1.  S D0=0
  1.  F  S D0=$O(^GMR(120.8,D0)) Q:'D0  D
  1.  . Q:$P($G(^GMR(120.8,D0,0)),U)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V45(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#.02) of the ADVERSE REACTION REPORTING File (#120.85)
  1.  ;
  1.  D HDR("V45",I)
  1.  S D0=0
  1.  F  S D0=$O(^GMR(120.85,D0)) Q:'D0  D
  1.  . Q:$P($G(^GMR(120.85,D0,0)),U,2)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V46(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#.03) of the PATIENT MOVEMENT File (#405)
  1.  ;
  1.  D HDR("V46",I)
  1.  S D0=0
  1.  F  S D0=$O(^DGPM(D0)) Q:'D0  D
  1.  . Q:$P($G(^DGPM(D0,0)),U,3)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V47(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#2) of the SCHEDULING VISITS File (#409.5)
  1.  ;
  1.  D HDR("V47",I)
  1.  S D0=0
  1.  F  S D0=$O(^SDV(D0)) Q:'D0  D
  1.  . Q:$P($G(^SDV(D0,0)),U,2)='DFN
  1.  . W !?5,D0,"   ",DFN
  1.  . S CNT=$G(CNT)+1
  1.  Q
  1. V48(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#8) of the INTERFACE CRITERIA File (#4001.1)
  1.  ;
  1.  D HDR("V48",I)
  1.  S D0=0
  1.  F  S D0=$O(^DIZ(4001.1,D0)) Q:'D0  D
  1.  . Q:$P($G(^DIZ(4001.1,D0,8)),U)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V49(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#.04) of the ALERT TRACKING File (#8992.1)
  1.  ;
  1.  D HDR("V49",I)
  1.  S D0=0
  1.  F  S D0=$O(^XTV(8992.1,D0)) Q:'D0  D
  1.  . Q:$P($G(^XTV(8992.1,D0,0)),U,4)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V50(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#1.1) of the VEN QUEUE File (#19707.2)
  1.  ;
  1.  D HDR("V50",I)
  1.  S D0=0
  1.  F  S D0=$O(^VEN(7.2,D0)) Q:'D0  D
  1.  . Q:$P($G(^VEN(7.2,D0,1)),U)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V51(DFN,I,CNT) ;
  1.  ;----- DEMO PATIENT field (#.14) of the VEN EHP CONFIGURATION File (#19707.5)
  1.  ;
  1.  D HDR("V51",I)
  1.  S D0=0
  1.  F  S D0=$O(^VEN(7.5,D0)) Q:'D0  D
  1.  . Q:$P($G(^VEN(7.5,D0,0)),U,14)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V52(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#.07) of the VEN EHP ERROR LOG File (#19707.7)
  1.  ;
  1.  D HDR("V52",I)
  1.  S D0=0
  1.  F  S D0=$O(^VEN(7.7,D0)) Q:'D0  D
  1.  . Q:$P($G(^VEN(7.7,D0,0)),U,7)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V53(DFN,I,CNT) ;
  1.  ;----- PATIENT NAME field (#.01) of the AZA MEDICAID MASTER LIST File (#1180007)
  1.  ;
  1.  D HDR("V53",I)
  1.  S D0=0
  1.  F  S D0=$O(^AZAMASTR(D0)) Q:'D0  D
  1.  . Q:$P($G(^AZAMASTR(D0,0)),U)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V54(DFN,I,CNT) ;
  1.  ;----- PATIENT NAME field (#.01) of the APC DATA File (#1800018)
  1.  ;
  1.  D HDR("V54",I)
  1.  S D0=0
  1.  F  S D0=$O(^AAPCRCDS(D0)) Q:'D0  D
  1.  . Q:$P($G(^AAPCRCDS(D0,0)),U)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V55(DFN,I,CNT) ;
  1.  ;----- NAME field (#.01) of the PATIENT File (#9000001)
  1.  ;
  1.  D HDR("V55",I)
  1.  S D0=DFN   ;DINUMED
  1.  Q:'$D(^AUPNPAT(D0))
  1.  D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V56(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#.01) of the PODIATRY HISTORY File (#9000028)     
  1.  ;
  1.  D HDR("V56",I)
  1.  S D0=DFN   ;DINUMED
  1.  Q:'$D(^AUPNPOD(D0))
  1.  D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V57(DFN,I,CNT) ;
  1.  ;----- PATIENT NAME field (#.01) of the ABSP COMBINED INSURANCE File (#9002313.1)
  1.  ;
  1.  D HDR("V57",I)
  1.  S D0=DFN   ;DINUMED
  1.  Q:'$D(^ABSPCOMB(D0))
  1.  D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V58(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#1.04) of the LINE ITEMS sub-field (#9002313.512) of the ABSP DATA INPUT File (#9002313.51)
  1.  ;
  1.  D HDR("V58",I)
  1.  S D0=0
  1.  F  S D0=$O(^ABSP(9002313.51,D0)) Q:'D0  D
  1.  . S D1=0
  1.  . F  S D1=$O(^ABSP(9002313.51,D0,2,D1)) Q:'D1  D
  1.  . . Q:$P($G(^ABSP(9002313.51,D0,2,D1,1)),U,4)'=DFN
  1.  . . W !?5,D0,?15,D1,?25,DFN
  1.  . . S CNT=$G(CNT)+1
  1.  Q
  1. V59(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#.02) of the APSP INTERVENTION File (#9009032.4)
  1.  ;
  1.  D HDR("V59",I)
  1.  S D0=0
  1.  F  S D0=$O(^APSPQA(32.4,D0)) Q:'D0  D
  1.  . Q:$P($G(^APSPQA(32.4,D0,0)),U,2)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. V60(DFN,I,CNT) ;
  1.  ;----- PATIENT field (#.02) of the APSP PRIMARY CARE VISIT File (#9009032.6)
  1.  ;
  1.  D HDR("V60",I)
  1.  S D0=0
  1.  F  S D0=$O(^APSPQA(32.6,D0)) Q:'D0  D
  1.  . Q:$P($G(^APSPQA(32.6,D0,0)),U,2)'=DFN
  1.  . D WRITE(D0,DFN,.CNT)
  1.  Q
  1. HDR(X,I) ;
  1.  ;----- WRITE HEADER
  1.  ;
  1.  W !!,I,"  ",$T(@(X)+1),!
  1.  Q
  1. WRITE(D0,X,CNT) ;
  1.  ;----- WRITE FINDINGS
  1.  ;
  1.  W !?5,D0,?15,X
  1.  S CNT=$G(CNT)+1
  1.  Q
  1. QUE(DFN) ;
  1.  ;
  1.  N %ZIS,POP,ZTDESC,ZTIO,ZTRTN,ZTSAVE
  1.  ;
  1.  S ZTSAVE("DFN")=""
  1.  S ZTRTN="DQ^AZAXDPM2"
  1.  S ZTDESC="FIND VA PATIENT FILE POINTERS"
  1.  ;
  1.  S %ZIS="Q"
  1.  D ^%ZIS
  1.  Q:POP
  1.  I $D(IO("Q")) D  Q
  1.  . K IO("Q")
  1.  . S ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
  1.  . D ^%ZTLOAD
  1.  . W !,"Task #",$G(ZTSK)," queued"
  1.  D @ZTRTN
  1.  Q