source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXCENEW.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.4 KB
Line 
1PXCENEW ;ISL/dee - Used to change the screening on the display of visit and appointments ;12/17/96
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**14**;Aug 12, 1996
3 ;; ;
4 Q
5 ;
6NEWHOSL ;Entry point for selecting new hospital location
7 D FULL^VALM1
8 Q:'$$NEWLOC($G(PXCEHLOC))
9 D NEWHOSL1
10 G MAKELIST
11 ;
12NEWHOSL1 ;Entry point from initial selection of hospital location
13 I $P(PXCEVIEW,"^",1)'="H" D
14 . S $P(PXCEVIEW,"^",1)="H"
15 . D SETDATES^PXCE
16 S SDAMTYP="C"
17 D PATKILL^PXCEPAT
18 Q
19 ;
20NEWHLOC ;
21 D FULL^VALM1
22 N X,Y,DONE
23 S DONE=0
24 I PXCEVIEW'["H" D
25 . N DIR,DA
26 . S DIR(0)="Y"
27 . S DIR("A")="Include all Clinics: "
28 . S DIR("B")="Yes"
29 . D ^DIR
30 . I Y K PXCEHLOC S DONE=1
31 I 'DONE Q:'$$NEWLOC($G(PXCEHLOC))
32 G MAKELIST
33 ;
34NEWLOC(HOSPLOC) ;
35 N NEWHLOC
36 S NEWHLOC=$P($$LOCATION($G(HOSPLOC)),"^")
37 I NEWHLOC'>0,("~H~P~"'[("~"_$P(PXCEVIEW,"^")_"~")) S VALMQUIT=1
38 I NEWHLOC'>0 Q 0
39 S PXCEHLOC=NEWHLOC
40 Q 1
41 ;
42LOCATION(HOSPLOC) ; Select a hospital location
43 N DIR,DA,X,Y
44 S DIR(0)="9000010,.22O"
45 S:$G(HOSPLOC)]"" DIR("B")=$P(^SC(HOSPLOC,0),"^",1)
46 D ^DIR
47 Q Y
48 ;
49CLINICST(CLINIC) ; Select a Clinic Stop Code
50 N DIC,DA,X,Y
51 S DIC="^DIC(40.7,"
52 S DIC(0)="AEM"
53 S DIC("S")="I $P(^(0),U,3)="""""
54 S:$G(CLINIC)]"" DIC("B")=$P(^DIC(40.7,CLINIC,0),"^",1)
55 D ^DIC
56 Q Y
57 ;
58MAKELIST ;
59 I PXCEVIEW["V" D
60 . D @$S(PXCEVIEW["H":"MAKELIST^PXCEHLOC",PXCEVIEW["P":"MAKELIST^PXCEPAT",1:"QUIT")
61 E I PXCEVIEW["A" D @$S(PXCEVIEW["H":"CLNSDAM3^PXCESDA3",PXCEVIEW["P":"PATSDAM1^PXCESDA1",1:"QUIT")
62 Q
63 ;
64QUIT Q
65 ;
Note: See TracBrowser for help on using the repository browser.