PXCENEW ;ISL/dee - Used to change the screening on the display of visit and appointments ;12/17/96
;;1.0;PCE PATIENT CARE ENCOUNTER;**14**;Aug 12, 1996
;; ;
Q
;
NEWHOSL ;Entry point for selecting new hospital location
D FULL^VALM1
Q:'$$NEWLOC($G(PXCEHLOC))
D NEWHOSL1
G MAKELIST
;
NEWHOSL1 ;Entry point from initial selection of hospital location
I $P(PXCEVIEW,"^",1)'="H" D
. S $P(PXCEVIEW,"^",1)="H"
. D SETDATES^PXCE
S SDAMTYP="C"
D PATKILL^PXCEPAT
Q
;
NEWHLOC ;
D FULL^VALM1
N X,Y,DONE
S DONE=0
I PXCEVIEW'["H" D
. N DIR,DA
. S DIR(0)="Y"
. S DIR("A")="Include all Clinics: "
. S DIR("B")="Yes"
. D ^DIR
. I Y K PXCEHLOC S DONE=1
I 'DONE Q:'$$NEWLOC($G(PXCEHLOC))
G MAKELIST
;
NEWLOC(HOSPLOC) ;
N NEWHLOC
S NEWHLOC=$P($$LOCATION($G(HOSPLOC)),"^")
I NEWHLOC'>0,("~H~P~"'[("~"_$P(PXCEVIEW,"^")_"~")) S VALMQUIT=1
I NEWHLOC'>0 Q 0
S PXCEHLOC=NEWHLOC
Q 1
;
LOCATION(HOSPLOC) ; Select a hospital location
N DIR,DA,X,Y
S DIR(0)="9000010,.22O"
S:$G(HOSPLOC)]"" DIR("B")=$P(^SC(HOSPLOC,0),"^",1)
D ^DIR
Q Y
;
CLINICST(CLINIC) ; Select a Clinic Stop Code
N DIC,DA,X,Y
S DIC="^DIC(40.7,"
S DIC(0)="AEM"
S DIC("S")="I $P(^(0),U,3)="""""
S:$G(CLINIC)]"" DIC("B")=$P(^DIC(40.7,CLINIC,0),"^",1)
D ^DIC
Q Y
;
MAKELIST ;
I PXCEVIEW["V" D
. D @$S(PXCEVIEW["H":"MAKELIST^PXCEHLOC",PXCEVIEW["P":"MAKELIST^PXCEPAT",1:"QUIT")
E I PXCEVIEW["A" D @$S(PXCEVIEW["H":"CLNSDAM3^PXCESDA3",PXCEVIEW["P":"PATSDAM1^PXCESDA1",1:"QUIT")
Q
;
QUIT Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCENEW 1543 printed Oct 16, 2024@18:28:49 Page 2
PXCENEW ;ISL/dee - Used to change the screening on the display of visit and appointments ;12/17/96
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**14**;Aug 12, 1996
+2 ;; ;
+3 QUIT
+4 ;
NEWHOSL ;Entry point for selecting new hospital location
+1 DO FULL^VALM1
+2 if '$$NEWLOC($GET(PXCEHLOC))
QUIT
+3 DO NEWHOSL1
+4 GOTO MAKELIST
+5 ;
NEWHOSL1 ;Entry point from initial selection of hospital location
+1 IF $PIECE(PXCEVIEW,"^",1)'="H"
Begin DoDot:1
+2 SET $PIECE(PXCEVIEW,"^",1)="H"
+3 DO SETDATES^PXCE
End DoDot:1
+4 SET SDAMTYP="C"
+5 DO PATKILL^PXCEPAT
+6 QUIT
+7 ;
NEWHLOC ;
+1 DO FULL^VALM1
+2 NEW X,Y,DONE
+3 SET DONE=0
+4 IF PXCEVIEW'["H"
Begin DoDot:1
+5 NEW DIR,DA
+6 SET DIR(0)="Y"
+7 SET DIR("A")="Include all Clinics: "
+8 SET DIR("B")="Yes"
+9 DO ^DIR
+10 IF Y
KILL PXCEHLOC
SET DONE=1
End DoDot:1
+11 IF 'DONE
if '$$NEWLOC($GET(PXCEHLOC))
QUIT
+12 GOTO MAKELIST
+13 ;
NEWLOC(HOSPLOC) ;
+1 NEW NEWHLOC
+2 SET NEWHLOC=$PIECE($$LOCATION($GET(HOSPLOC)),"^")
+3 IF NEWHLOC'>0
IF ("~H~P~"'[("~"_$PIECE(PXCEVIEW,"^")_"~"))
SET VALMQUIT=1
+4 IF NEWHLOC'>0
QUIT 0
+5 SET PXCEHLOC=NEWHLOC
+6 QUIT 1
+7 ;
LOCATION(HOSPLOC) ; Select a hospital location
+1 NEW DIR,DA,X,Y
+2 SET DIR(0)="9000010,.22O"
+3 if $GET(HOSPLOC)]""
SET DIR("B")=$PIECE(^SC(HOSPLOC,0),"^",1)
+4 DO ^DIR
+5 QUIT Y
+6 ;
CLINICST(CLINIC) ; Select a Clinic Stop Code
+1 NEW DIC,DA,X,Y
+2 SET DIC="^DIC(40.7,"
+3 SET DIC(0)="AEM"
+4 SET DIC("S")="I $P(^(0),U,3)="""""
+5 if $GET(CLINIC)]""
SET DIC("B")=$PIECE(^DIC(40.7,CLINIC,0),"^",1)
+6 DO ^DIC
+7 QUIT Y
+8 ;
MAKELIST ;
+1 IF PXCEVIEW["V"
Begin DoDot:1
+2 DO @$SELECT(PXCEVIEW["H":"MAKELIST^PXCEHLOC",PXCEVIEW["P":"MAKELIST^PXCEPAT",1:"QUIT")
End DoDot:1
+3 IF '$TEST
IF PXCEVIEW["A"
DO @$SELECT(PXCEVIEW["H":"CLNSDAM3^PXCESDA3",PXCEVIEW["P":"PATSDAM1^PXCESDA1",1:"QUIT")
+4 QUIT
+5 ;
QUIT QUIT
+1 ;
