PXPT.m

PXPT ;ISL/MKB,DLT,dee - Patient/IHS maintenance routine ;8/10/96

 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996

 ;IHS/ITSC/LJF 5/28/2003  IHS sites already have file 9000001 populated

 ;                          setting PCE parameter to say that

 ;IHS/ITSC/LJF 5/30/2003  PXPT Location could be set to -1 or wrong site

 ;

EN ; entry point

 D LOC,MASTER,QUE

 Q

 ;

LOC ;POPULATE LOCATION FILE

 D BMES^XPDUTL("Populating the LOCATION File #9999999.06 from the Institution File")

 K DD,DO

 S DIC="^AUTTLOC(",DIC(0)=""

 S PXPTINST=0 F  S PXPTINST=$O(^DIC(4,PXPTINST)) Q:'PXPTINST  S (X,DINUM)=PXPTINST D FILE^DICN

 K PXPTINST

 Q

 ;

MASTER ;Populate the PXPT fields $501 & #502 in PCE PARAMETERS file (#815)

 ;

 N PXPTLOC

 D BMES^XPDUTL("Populating the PXPT fields of the PCE PARAMETERS file (#815)")

 S PXPTLOC=+$G(XPDQUES("POS PXPT LOCATION"))

 D:PXPTLOC'>0 GETLOC

 S:PXPTLOC'>0 PXPTLOC=+$$SITE^VASITE

 ;I '(+$G(^PX(815,1,"PXPT"))) S $P(^PX(815,1,"PXPT"),"^",1)=PXPTLOC    ;IHS/ITSC/LJF 5/30/2003

 S $P(^PX(815,1,"PXPT"),"^",1)=PXPTLOC                                 ;IHS/ITSC/LJF 5/30/2003

 ;I $P($G(^PX(815,1,"PXPT")),"^",2)="" S $P(^PX(815,1,"PXPT"),"^",2)="READY TO POPULATE"  ;IHS/ITSC/LJF 5/28/2003

 I $P($G(^PX(815,1,"PXPT")),"^",2)="" S $P(^PX(815,1,"PXPT"),"^",2)=0                     ;IHS/ITSC/LJF 5/28/2003

 Q

 ;

QUE ; Queue job to populate IHS Patient File #9000001

 N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK

 N PXPTLOC,DINUM

 D GETLOC I 'PXPTLOC W $C(7),!!,"Error in setup, run D MASTER^PXPTPOST" Q

 S PXPTLAST=$P($G(^PX(815,1,"PXPT")),"^",2)

 I PXPTLAST=0 Q    ;IHS/ITSC/LJF 5/28/2003

 I PXPTLAST=0 D  Q:'Y  Q:Y["^"

 .W !!,"The population of the Patient/IHS file has previously completed.",!

 .S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to retask the job to populate the Patient/IHS file"

 .D ^DIR

 I PXPTLAST>0 D

 .W !!,"The population of the Patient/IHS file is partially completed."

 .W !,"Populating will start from the patient last populated from the previous"

 .W !,"tasked job."

Q1 W !!,"Populating the Patient/IHS File #9000001 via the following queued job ... "

 W !!,">> I will queue this job; please specify a start time for it."

 S ZTRTN="LOAD^PXXDPT",ZTDESC="Patient File (#9000001) Population",ZTIO=""

 S ZTSAVE("PXPTLOC")=PXPTLOC

 D ^%ZTLOAD

 I '$D(ZTSK) W $C(7),!!,"You MUST schedule this job at this time!",!,"This is a required task.",! G QUE

 W !,"Task #"_ZTSK

 Q

 ;

 ;

GETLOC S PXPTLOC=$P($G(^PX(815,1,"PXPT")),"^",1)

 Q

 ;

PXPT      ;ISL/MKB,DLT,dee - Patient/IHS maintenance routine ;8/10/96

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996

 +2       ;IHS/ITSC/LJF 5/28/2003  IHS sites already have file 9000001 populated

 +3       ;                          setting PCE parameter to say that

 +4       ;IHS/ITSC/LJF 5/30/2003  PXPT Location could be set to -1 or wrong site

 +5       ;

EN        ; entry point

 +1        DO LOC

           DO MASTER

           DO QUE

 +2        QUIT 

 +3       ;

LOC       ;POPULATE LOCATION FILE

 +1        DO BMES^XPDUTL("Populating the LOCATION File #9999999.06 from the Institution File")

 +2        KILL DD,DO

 +3        SET DIC="^AUTTLOC("

           SET DIC(0)=""

 +4        SET PXPTINST=0

           FOR 

               SET PXPTINST=$ORDER(^DIC(4,PXPTINST))

               IF 'PXPTINST

                   QUIT 

               SET (X,DINUM)=PXPTINST

               DO FILE^DICN

 +5        KILL PXPTINST

 +6        QUIT 

 +7       ;

MASTER    ;Populate the PXPT fields $501 & #502 in PCE PARAMETERS file (#815)

 +1       ;

 +2        NEW PXPTLOC

 +3        DO BMES^XPDUTL("Populating the PXPT fields of the PCE PARAMETERS file (#815)")

 +4        SET PXPTLOC=+$GET(XPDQUES("POS PXPT LOCATION"))

 +5        IF PXPTLOC'>0

               DO GETLOC

 +6        IF PXPTLOC'>0

               SET PXPTLOC=+$$SITE^VASITE

 +7       ;I '(+$G(^PX(815,1,"PXPT"))) S $P(^PX(815,1,"PXPT"),"^",1)=PXPTLOC    ;IHS/ITSC/LJF 5/30/2003

 +8       ;IHS/ITSC/LJF 5/30/2003

           SET $PIECE(^PX(815,1,"PXPT"),"^",1)=PXPTLOC

 +9       ;I $P($G(^PX(815,1,"PXPT")),"^",2)="" S $P(^PX(815,1,"PXPT"),"^",2)="READY TO POPULATE"  ;IHS/ITSC/LJF 5/28/2003

 +10      ;IHS/ITSC/LJF 5/28/2003

           IF $PIECE($GET(^PX(815,1,"PXPT")),"^",2)=""

               SET $PIECE(^PX(815,1,"PXPT"),"^",2)=0

 +11       QUIT 

 +12      ;

QUE       ; Queue job to populate IHS Patient File #9000001

 +1        NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK

 +2        NEW PXPTLOC,DINUM

 +3        DO GETLOC

           IF 'PXPTLOC

               WRITE $CHAR(7),!!,"Error in setup, run D MASTER^PXPTPOST"

               QUIT 

 +4        SET PXPTLAST=$PIECE($GET(^PX(815,1,"PXPT")),"^",2)

 +5       ;IHS/ITSC/LJF 5/28/2003

           IF PXPTLAST=0

               QUIT 

 +6        IF PXPTLAST=0

               Begin DoDot:1

 +7                WRITE !!,"The population of the Patient/IHS file has previously completed.",!

 +8                SET DIR(0)="Y"

                   SET DIR("B")="NO"

                   SET DIR("A")="Do you want to retask the job to populate the Patient/IHS file"

 +9                DO ^DIR

               End DoDot:1

               IF 'Y

                   QUIT 

               IF Y["^"

                   QUIT 

 +10       IF PXPTLAST>0

               Begin DoDot:1

 +11               WRITE !!,"The population of the Patient/IHS file is partially completed."

 +12               WRITE !,"Populating will start from the patient last populated from the previous"

 +13               WRITE !,"tasked job."

               End DoDot:1

Q1         WRITE !!,"Populating the Patient/IHS File #9000001 via the following queued job ... "

 +1        WRITE !!,">> I will queue this job; please specify a start time for it."

 +2        SET ZTRTN="LOAD^PXXDPT"

           SET ZTDESC="Patient File (#9000001) Population"

           SET ZTIO=""

 +3        SET ZTSAVE("PXPTLOC")=PXPTLOC

 +4        DO ^%ZTLOAD

 +5        IF '$DATA(ZTSK)

               WRITE $CHAR(7),!!,"You MUST schedule this job at this time!",!,"This is a required task.",!

               GOTO QUE

 +6        WRITE !,"Task #"_ZTSK

 +7        QUIT 

 +8       ;

 +9       ;

GETLOC     SET PXPTLOC=$PIECE($GET(^PX(815,1,"PXPT")),"^",1)

 +1        QUIT 

 +2       ;