source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXPT.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1PXPT ;ISL/MKB,DLT,dee - Patient/IHS maintenance routine ;8/10/96
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
3EN ; entry point
4 D LOC,MASTER,QUE
5 Q
6 ;
7LOC ;POPULATE LOCATION FILE
8 D BMES^XPDUTL("Populating the LOCATION File #9999999.06 from the Institution File")
9 K DD,DO
10 S DIC="^AUTTLOC(",DIC(0)=""
11 S PXPTINST=0 F S PXPTINST=$O(^DIC(4,PXPTINST)) Q:'PXPTINST S (X,DINUM)=PXPTINST D FILE^DICN
12 K PXPTINST
13 Q
14 ;
15MASTER ;Populate the PXPT fields $501 & #502 in PCE PARAMETERS file (#815)
16 ;
17 N PXPTLOC
18 D BMES^XPDUTL("Populating the PXPT fields of the PCE PARAMETERS file (#815)")
19 S PXPTLOC=+$G(XPDQUES("POS PXPT LOCATION"))
20 D:PXPTLOC'>0 GETLOC
21 S:PXPTLOC'>0 PXPTLOC=+$$SITE^VASITE
22 I '(+$G(^PX(815,1,"PXPT"))) S $P(^PX(815,1,"PXPT"),"^",1)=PXPTLOC
23 I $P($G(^PX(815,1,"PXPT")),"^",2)="" S $P(^PX(815,1,"PXPT"),"^",2)="READY TO POPULATE"
24 Q
25 ;
26QUE ; Queue job to populate IHS Patient File #9000001
27 N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK
28 N PXPTLOC,DINUM
29 D GETLOC I 'PXPTLOC W $C(7),!!,"Error in setup, run D MASTER^PXPTPOST" Q
30 S PXPTLAST=$P($G(^PX(815,1,"PXPT")),"^",2)
31 I PXPTLAST=0 D Q:'Y Q:Y["^"
32 .W !!,"The population of the Patient/IHS file has previously completed.",!
33 .S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to retask the job to populate the Patient/IHS file"
34 .D ^DIR
35 I PXPTLAST>0 D
36 .W !!,"The population of the Patient/IHS file is partially completed."
37 .W !,"Populating will start from the patient last populated from the previous"
38 .W !,"tasked job."
39Q1 W !!,"Populating the Patient/IHS File #9000001 via the following queued job ... "
40 W !!,">> I will queue this job; please specify a start time for it."
41 S ZTRTN="LOAD^PXXDPT",ZTDESC="Patient File (#9000001) Population",ZTIO=""
42 S ZTSAVE("PXPTLOC")=PXPTLOC
43 D ^%ZTLOAD
44 I '$D(ZTSK) W $C(7),!!,"You MUST schedule this job at this time!",!,"This is a required task.",! G QUE
45 W !,"Task #"_ZTSK
46 Q
47 ;
48 ;
49GETLOC S PXPTLOC=$P($G(^PX(815,1,"PXPT")),"^",1)
50 Q
51 ;
Note: See TracBrowser for help on using the repository browser.