| [613] | 1 | PXCENEW ;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 | ;
|
|---|
| 6 | NEWHOSL ;Entry point for selecting new hospital location
|
|---|
| 7 | D FULL^VALM1
|
|---|
| 8 | Q:'$$NEWLOC($G(PXCEHLOC))
|
|---|
| 9 | D NEWHOSL1
|
|---|
| 10 | G MAKELIST
|
|---|
| 11 | ;
|
|---|
| 12 | NEWHOSL1 ;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 | ;
|
|---|
| 20 | NEWHLOC ;
|
|---|
| 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 | ;
|
|---|
| 34 | NEWLOC(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 | ;
|
|---|
| 42 | LOCATION(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 | ;
|
|---|
| 49 | CLINICST(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 | ;
|
|---|
| 58 | MAKELIST ;
|
|---|
| 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 | ;
|
|---|
| 64 | QUIT Q
|
|---|
| 65 | ;
|
|---|
