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

AGTXALL1.m

Go to the documentation of this file. 
  1. AGTXALL1 ;IHS/ASDS/EFG - EXPORT ALL REG DATA CONT. ;  
  1.  ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
  1.  ;
  1. CHK() ;EP - Check if today is before the schedule export date. If so, confirm.
  1.  I DT>$$WHEN($E($P(^AUTTLOC($P(^AUTTSITE(1,0),U,1),0),U,10),1,2)) Q 1
  1.  D ALL,HELP^XBHELP("H","AGTXALL1")
  1.  Q $$DIR^XBDIR("YO","Proceed","N","","YOU'RE EARLY.  Do you still want to proceed with the extract  (Y/N)")
  1.  ;
  1. SCHED ;;^AREA^EXPORT DATE^EXPORT DATE FM
  1.  ;;^Alaska^ 9-Oct-01^3011009
  1.  ;;^Billings^10-Oct-01^3011010
  1.  ;;^Tucson^11-Oct-01^3011011
  1.  ;;^California^12-Oct-01^3011012
  1.  ;;^Navajo^15-Oct-01^3011015
  1.  ;;^Albuquerque^16-Oct-01^3011016
  1.  ;;^Phoenix^17-Oct-01^3011017
  1.  ;;^Nashville^18-Oct-01^3011018
  1.  ;;^Portland^22-Oct-01^3011022
  1.  ;;^Aberdeen^23-Oct-01^3011023
  1.  ;;^Bemidji^24-Oct-01^3011024
  1.  ;;^Oklahoma^25-Oct-01^3011025
  1.  ;
  1. ALL ;EP - Display the whole schedule.
  1.  F %=1:1:12 W !?5,$P($T(SCHED+%),U,2),?20,$P($T(SCHED+%),U,3)
  1.  Q
  1. H ;
  1.  ;;According to the RPMS SITE file, your facility, 
  1.  ;;@;$P(^DIC(4,$P(^AUTTSITE(1,0),U,1),0),U,1)_", "
  1.  ;;is in the 
  1.  ;;@;$P(^AUTTAREA($P(^AUTTLOC($P(^AUTTSITE(1,0),U,1),0),U,4),0),U,1)_" area."
  1.  ;;According to the export schedule, you should perform your comprehensive
  1.  ;;extract on:  
  1.  ;;@;$$FMTE^XLFDT($$WHEN^AGTXALL1($E($P(^AUTTLOC($P(^AUTTSITE(1,0),U,1),0),U,10),1,2)))_"."
  1.  ;;If local circumstances dictate an early extract, just answer "Y" to the
  1.  ;;prompt, below.  We prefer that you wait until 
  1.  ;;@;$$FMTE^XLFDT($$WHEN^AGTXALL1($E($P(^AUTTLOC($P(^AUTTSITE(1,0),U,1),0),U,10),1,2)))_".  If you proceed,"
  1.  ;;notify help desk.
  1.  ;;###
  1. WHEN(A) ;EP - Lookup when an Area should export, given area code A.
  1.  Q $S('$L($T(@A)):"<not found>",1:$P($T(SCHED+$P($T(@A),U,2)),U,4))
  1.  ;
  1.  ;;area name ^ offset from "SCHED"
  1. 10 ;;ABERDEEN^10
  1. 15 ;;ABERDEEN TRIBE/638^10
  1. 17 ;;ABERDEEN URBAN^10
  1. 30 ;;ALASKA^1
  1. 39 ;;ALASKA NON-IHS^1
  1. 35 ;;ALASKA TRIBE/638^1
  1. 20 ;;ALBUQUERQUE^6
  1. 25 ;;ALBUQUERQUE TRIBE/638^6
  1. 11 ;;BEMIDJI^11
  1. 18 ;;BEMIDJI NON-IHS^11
  1. 16 ;;BEMIDJI TRIBE/638^11
  1. 14 ;;BEMIDJI URBAN^11
  1. 40 ;;BILLINGS^2
  1. 45 ;;BILLINGS TRIBE/638^2
  1. 47 ;;BILLINGS URBAN^2
  1. 61 ;;CALIFORNIA^4
  1. 68 ;;CALIFORNIA NON-IHS^4
  1. 66 ;;CALIFORNIA TRIBE/638^4
  1. 64 ;;CALIFORNIA URBAN^4
  1. 99 ;;HEADQUARTERS EAST
  1. 23 ;;HEADQUARTERS WEST
  1. 51 ;;NASHVILLE^8
  1. 58 ;;NASHVILLE NON-IHS^8
  1. 56 ;;NASHVILLE TRIBE/638^8
  1. 54 ;;NASHVILLE URBAN^8
  1. 80 ;;NAVAJO^5
  1. 89 ;;NAVAJO NON-IHS^5
  1. 85 ;;NAVAJO TRIBE/638^5
  1. 50 ;;OKLAHOMA^12
  1. 59 ;;OKLAHOMA NON-IHS^12
  1. 55 ;;OKLAHOMA TRIBE/638^12
  1. 57 ;;OKLAHOMA URBAN^12
  1. 60 ;;PHOENIX^7
  1. 69 ;;PHOENIX NON-IHS^7
  1. 65 ;;PHOENIX TRIBE/638^7
  1. 67 ;;PHOENIX URBAN^7
  1. 70 ;;PORTLAND^9
  1. 79 ;;PORTLAND NON-IHS^9
  1. 75 ;;PORTLAND TRIBE/638^9
  1. 77 ;;PORTLAND URBAN^9
  1. 00 ;;TUCSON^3
  1. 09 ;;TUCSON NON-IHS^3
  1. 05 ;;TUCSON TRIBE/638^3
  1. 07 ;;TUCSON URBAN^3
  1.  ;
  1.  ;For possible future use.
  1. RG9(DFN) ;- Given the DFN, create RG9 record(s) of unique Visit IDs.
  1.  Q:'$G(DFN)
  1.  NEW AG,AGV
  1.  S (AG,AGV)=0
  1.  F  S AGV=$O(^AUPNVSIT("AC",DFN,AGV)) Q:'AGV  S T(9)=$G(T(9))_U_AGV S AG=AG+1 I AG=28 S T(9)="RG9"_U_T(9) D SET^AGTXALL(9) S T(9)=""
  1.  Q
  1.  ;For possible future use.
  1. VID(V) ;EP - Given Visit IEN, return unique Visit record id.
  1.  ;If not there, stuff the ASUFAC into RPMS SITE for durability.
  1.  I '$P($G(^AUTTSITE(1,1)),U,3) S $P(^AUTTSITE(1,1),U,3)=$P(^AUTTLOC($P(^AUTTSITE(1,0),U,1),0),U,10)
  1.  Q $P(^AUTTSITE(1,1),U,3)_$E("0000000000",1,10-$L(V))_V