PXCENEW.m

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

 ;

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       ;