- 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 Jan 18, 2025@03:29:08 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 ;