PXPT ;ISL/MKB,DLT,dee - Patient/IHS maintenance routine ;8/10/96
;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
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
I $P($G(^PX(815,1,"PXPT")),"^",2)="" S $P(^PX(815,1,"PXPT"),"^",2)="READY TO POPULATE"
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 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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXPT 1988 printed Oct 16, 2024@18:30:28 Page 2
PXPT ;ISL/MKB,DLT,dee - Patient/IHS maintenance routine ;8/10/96
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
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 IF '(+$GET(^PX(815,1,"PXPT")))
SET $PIECE(^PX(815,1,"PXPT"),"^",1)=PXPTLOC
+8 IF $PIECE($GET(^PX(815,1,"PXPT")),"^",2)=""
SET $PIECE(^PX(815,1,"PXPT"),"^",2)="READY TO POPULATE"
+9 QUIT
+10 ;
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 IF PXPTLAST=0
Begin DoDot:1
+6 WRITE !!,"The population of the Patient/IHS file has previously completed.",!
+7 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Do you want to retask the job to populate the Patient/IHS file"
+8 DO ^DIR
End DoDot:1
if 'Y
QUIT
if Y["^"
QUIT
+9 IF PXPTLAST>0
Begin DoDot:1
+10 WRITE !!,"The population of the Patient/IHS file is partially completed."
+11 WRITE !,"Populating will start from the patient last populated from the previous"
+12 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 ;
