- 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 Feb 18, 2025@23:56:08 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 ;