VPRDJ09 ;SLC/MKB -- PCE ;8/2/11 15:29
;;1.0;VIRTUAL PATIENT RECORD;**2,5**;Sep 01, 2011;Build 21
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^AUPNVSIT 2028
; ^PXRMINDX 4290
; ^SC 10040
; ^VA(200 10060
; DIC 2051
; DILFD 2055
; DIQ 2056
; PXAPI,^TMP("PXKENC" 1894
; VALM1 10116
; XUAF4 2171
;
; All tags expect DFN, ID, [VPRSTART, VPRSTOP, VPRMAX, VPRTEXT]
;
PX(FNUM) ; -- PCE item(s)
N VPRIDT,ID
D SORT ;sort ^PXRMINDX into ^TMP("VPRPX",$J,IDT)
S VPRIDT=0 F S VPRIDT=$O(^TMP("VPRPX",$J,VPRIDT)) Q:VPRIDT<1 D Q:VPRI'<VPRMAX
. S ID=0 F S ID=$O(^TMP("VPRPX",$J,VPRIDT,ID)) Q:ID<1 D Q:VPRI'<VPRMAX
.. I $G(VPRID),ID'=VPRID Q
.. D PX1
K ^TMP("VPRPX",$J)
Q
;
PX1 ; -- PCE ^TMP("VPRPX",$J,VPRIDT,ID)=ITM^DATE for FNUM
N N,COLL,TAG,VPRF,FLD,TMP,VISIT,X0,X12,FAC,LOC,X,Y,PCE
S N=+$P(FNUM,".",2),TAG=$S(N=7:"VPOV",N=11:"VIMM",N=12:"VSKIN",N=13:"VXAM",N=16:"VPEDU",N=18:"VCPT",1:"VHF")
D @(TAG_"^PXPXRM(ID,.VPRF)")
;
S PCE("localId")=ID,TMP=$G(^TMP("VPRPX",$J,VPRIDT,ID))
S COLL=$S(N=7:"pov",N=11:"immunization",N=12:"skin",N=13:"exam",N=16:"education",N=18:"cpt",1:"factor")
S PCE("uid")=$$SETUID^VPRUTILS(COLL,DFN,ID)
; TAG=$S(N=23:"recorded",N=11:"administeredDateTime",1:"dateTimeEntered")
S TAG=$S(N=11:"administeredDateTime",1:"entered")
S PCE(TAG)=$$JSONDT^VPRUTILS($P(TMP,U,2))
S PCE("name")=$S($P(TMP,U,3)="10D":$P(TMP,U),1:$$EXTERNAL^DILFD(FNUM,.01,,+TMP))
S VISIT=+$G(VPRF("VISIT")),PCE("encounterUid")=$$SETUID^VPRUTILS("visit",DFN,VISIT)
S PCE("encounterName")=$$NAME^VPRDJ04(VISIT)
S X0=$G(^AUPNVSIT(+VISIT,0)),FAC=+$P(X0,U,6),LOC=+$P(X0,U,22)
S:FAC X=$$STA^XUAF4(FAC)_U_$P($$NS^XUAF4(FAC),U)
S:'FAC X=$$FAC^VPRD(LOC)
D FACILITY^VPRUTILS(X,"PCE")
S:LOC PCE("locationUid")=$$SETUID^VPRUTILS("location",,LOC),PCE("locationName")=$P($G(^SC(LOC,0)),U)
S X=$G(VPRF("COMMENTS")) S:$L(X) PCE("comment")=X
POV I FNUM=9000010.07 D G PXQ
. S X=$G(VPRF("PRIMARY/SECONDARY")),PCE("type")=$S($L(X):X,1:"U")
. S Y=$$LOW^XLFSTR($P(TMP,U,3)) ;coding system
. S X=PCE("name"),PCE("icdCode")=$$SETNCS^VPRUTILS(Y,X)
. S X=$G(VPRF("PROVIDER NARRATIVE")),PCE("name")=$$EXTERNAL^DILFD(9000010.07,.04,,X)
CPT I FNUM=9000010.18 D G PXQ
. S X=$G(VPRF("PRINCIPAL PROCEDURE")),PCE("type")=$S($L(X):X,1:"U")
. S X=PCE("name"),PCE("cptCode")=$$SETNCS^VPRUTILS("cpt",X)
. S X=$G(VPRF("PROVIDER NARRATIVE")),PCE("name")=$$EXTERNAL^DILFD(9000010.18,.04,,X)
. S PCE("quantity")=VPRF("QUANTITY")
S X=$G(VPRF("VALUE")),FLD=$S(FNUM=9000010.16:.06,1:.04)
S Y=$$EXTERNAL^DILFD(FNUM,FLD,,X)
IM I FNUM=9000010.11 D G PXQ ;immunization
. S:$L(Y) PCE("seriesName")=Y,PCE("seriesCode")=$$SETUID^VPRUTILS("series",DFN,Y)
. S X=$G(VPRF("REACTION")) I $L(X) D
.. S PCE("reactionName")=$$EXTERNAL^DILFD(9000010.11,.06,,X)
.. S PCE("reactionCode")=$$SETUID^VPRUTILS("reaction",DFN,X)
. S PCE("contraindicated")=$S(+$G(VPRF("CONTRAINDICATED")):"true",1:"false")
. I '$D(^TMP("PXKENC",$J,VISIT)) D ENCEVENT^PXAPI(VISIT,1)
. S X12=$G(^TMP("PXKENC",$J,VISIT,"IMM",ID,12))
. S X=$P(X12,U,4) S:'X X=$P(X12,U,2)
. I 'X S I=0 F S I=$O(^TMP("PXKENC",$J,VISIT,"PRV",I)) Q:I<1 I $P($G(^(I,0)),U,4)="P" S X=+^(0) Q
. S:X PCE("performerUid")=$$SETUID^VPRUTILS("user",,+X),PCE("performerName")=$P($G(^VA(200,X,0)),U)
. ; CPT mapping
. S X=+$$FIND1^DIC(811.1,,"QX",+TMP_";AUTTIMM(","B") I X>0 D
.. S Y=$$GET1^DIQ(811.1,X_",",.02,"I") Q:Y<1
.. N CPT S CPT=$G(@(U_$P(Y,";",2)_+Y_",0)"))
.. S PCE("cptCode")=$$SETNCS^VPRUTILS("cpt",+CPT)
.. S (PCE("summary"),PCE("cptName"))=$P(CPT,U,2)
HF I FNUM=9000010.23 D G PXQ ;health factor
. S:$L(X) PCE("severityUid")=$$SETVURN^VPRUTILS("factor-severity",X),PCE("severityName")=$$LOWER^VALM1(Y)
. S X=$$GET1^DIQ(9999999.64,+TMP_",",.03,"I") I X D
.. S PCE("categoryUid")=$$SETVURN^VPRUTILS("factor-category",X)
.. S PCE("categoryName")=$$EXTERNAL^DILFD(9999999.64,.03,"",X)
. S X=$$GET1^DIQ(9999999.64,+TMP_",",.08)
. I $E(X)="Y" S PCE("display")="true"
. S PCE("kind")="Health Factor",PCE("summary")=PCE("name")
SK I FNUM=9000010.12 D ;skin test [fall thru to set result]
. S X=$G(VPRF("READING")) S:$L(X) PCE("reading")=X
. S X=$G(VPRF("DATE READ")) S:X PCE("dateRead")=$$JSONDT^VPRUTILS(X)
S:$L(Y) PCE("result")=Y
PXQ ;finish
D ADD^VPRDJ("PCE",COLL)
Q
;
SORT ; -- build ^TMP("VPRPX",$J,9999999-DATE,DA)=ITEM^DATE^[SYS] in range
; Expects VPRSTART and VPRSTOP
N TYPE,ITEM,DATE,DA,IDT,SYS K ^TMP("VPRPX",$J)
I FNUM=9000010.07!(FNUM=9000010.18) D Q
. N INDEX
. S INDEX=$NA(^PXRMINDX(FNUM)) D PPI(INDEX)
. I FNUM=9000010.07 S INDEX=$NA(^PXRMINDX(FNUM,"10D")) D PPI(INDEX)
PI ; from ^PXRMINDX(FNUM,"PI",DFN,ITEM,DATE,DA)
S ITEM=0 F S ITEM=$O(^PXRMINDX(FNUM,"PI",+$G(DFN),ITEM)) Q:ITEM<1 D
. S DATE=0 F S DATE=$O(^PXRMINDX(FNUM,"PI",+$G(DFN),ITEM,DATE)) Q:DATE<1 D
.. Q:DATE<VPRSTART Q:DATE>VPRSTOP S IDT=9999999-DATE
.. S DA=0 F S DA=$O(^PXRMINDX(FNUM,"PI",+$G(DFN),ITEM,DATE,DA)) Q:DA<1 S ^TMP("VPRPX",$J,IDT,DA)=ITEM_U_DATE
Q
PPI(INDX) ; from ^PXRMINDX(FNUM,["10D",]"PPI",DFN,TYPE,ITEM,DATE,DA)
S TYPE="" F S TYPE=$O(@INDX@("PPI",+$G(DFN),TYPE)) Q:TYPE="" D
. S ITEM="" F S ITEM=$O(@INDX@("PPI",+$G(DFN),TYPE,ITEM)) Q:ITEM="" D
.. S DATE=0 F S DATE=$O(@INDX@("PPI",+$G(DFN),TYPE,ITEM,DATE)) Q:DATE<1 D
... Q:DATE<VPRSTART Q:DATE>VPRSTOP S IDT=9999999-DATE
... S SYS=$S(INDX["10D":"10D",INDX[".07":"ICD",1:"CPT")
... S DA=0 F S DA=$O(@INDX@("PPI",+$G(DFN),TYPE,ITEM,DATE,DA)) Q:DA<1 S ^TMP("VPRPX",$J,IDT,DA)=ITEM_U_DATE_U_SYS
Q
PTF ; from ^PXRMINDX(45,"ICD","PNI",DFN,TYPE,ITEM,DATE,DA)
; Expects VPRSTART and VPRSTOP
N SYS,TYPE,ITEM,DATE,IDT,DA
F SYS="ICD","10D" D
.S TYPE="" F S TYPE=$O(^PXRMINDX(45,SYS,"PNI",+$G(DFN),TYPE)) Q:TYPE="" D
.. S ITEM=0 F S ITEM=$O(^PXRMINDX(45,SYS,"PNI",+$G(DFN),TYPE,ITEM)) Q:ITEM<1 D
... S DATE=0 F S DATE=$O(^PXRMINDX(45,SYS,"PNI",+$G(DFN),TYPE,ITEM,DATE)) Q:DATE<1 D
.... Q:DATE<VPRSTART Q:DATE>VPRSTOP S IDT=9999999-DATE
.... S DA="" F S DA=$O(^PXRMINDX(45,SYS,"PNI",+$G(DFN),TYPE,ITEM,DATE,DA)) Q:DA="" S ^TMP("VPRPX",$J,IDT,DA_";"_TYPE)=ITEM_U_DATE_U_SYS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRDJ09 6478 printed Nov 22, 2024@17:54:36 Page 2
VPRDJ09 ;SLC/MKB -- PCE ;8/2/11 15:29
+1 ;;1.0;VIRTUAL PATIENT RECORD;**2,5**;Sep 01, 2011;Build 21
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^AUPNVSIT 2028
+7 ; ^PXRMINDX 4290
+8 ; ^SC 10040
+9 ; ^VA(200 10060
+10 ; DIC 2051
+11 ; DILFD 2055
+12 ; DIQ 2056
+13 ; PXAPI,^TMP("PXKENC" 1894
+14 ; VALM1 10116
+15 ; XUAF4 2171
+16 ;
+17 ; All tags expect DFN, ID, [VPRSTART, VPRSTOP, VPRMAX, VPRTEXT]
+18 ;
PX(FNUM) ; -- PCE item(s)
+1 NEW VPRIDT,ID
+2 ;sort ^PXRMINDX into ^TMP("VPRPX",$J,IDT)
DO SORT
+3 SET VPRIDT=0
FOR
SET VPRIDT=$ORDER(^TMP("VPRPX",$JOB,VPRIDT))
if VPRIDT<1
QUIT
Begin DoDot:1
+4 SET ID=0
FOR
SET ID=$ORDER(^TMP("VPRPX",$JOB,VPRIDT,ID))
if ID<1
QUIT
Begin DoDot:2
+5 IF $GET(VPRID)
IF ID'=VPRID
QUIT
+6 DO PX1
End DoDot:2
if VPRI'<VPRMAX
QUIT
End DoDot:1
if VPRI'<VPRMAX
QUIT
+7 KILL ^TMP("VPRPX",$JOB)
+8 QUIT
+9 ;
PX1 ; -- PCE ^TMP("VPRPX",$J,VPRIDT,ID)=ITM^DATE for FNUM
+1 NEW N,COLL,TAG,VPRF,FLD,TMP,VISIT,X0,X12,FAC,LOC,X,Y,PCE
+2 SET N=+$PIECE(FNUM,".",2)
SET TAG=$SELECT(N=7:"VPOV",N=11:"VIMM",N=12:"VSKIN",N=13:"VXAM",N=16:"VPEDU",N=18:"VCPT",1:"VHF")
+3 DO @(TAG_"^PXPXRM(ID,.VPRF)")
+4 ;
+5 SET PCE("localId")=ID
SET TMP=$GET(^TMP("VPRPX",$JOB,VPRIDT,ID))
+6 SET COLL=$SELECT(N=7:"pov",N=11:"immunization",N=12:"skin",N=13:"exam",N=16:"education",N=18:"cpt",1:"factor")
+7 SET PCE("uid")=$$SETUID^VPRUTILS(COLL,DFN,ID)
+8 ; TAG=$S(N=23:"recorded",N=11:"administeredDateTime",1:"dateTimeEntered")
+9 SET TAG=$SELECT(N=11:"administeredDateTime",1:"entered")
+10 SET PCE(TAG)=$$JSONDT^VPRUTILS($PIECE(TMP,U,2))
+11 SET PCE("name")=$SELECT($PIECE(TMP,U,3)="10D":$PIECE(TMP,U),1:$$EXTERNAL^DILFD(FNUM,.01,,+TMP))
+12 SET VISIT=+$GET(VPRF("VISIT"))
SET PCE("encounterUid")=$$SETUID^VPRUTILS("visit",DFN,VISIT)
+13 SET PCE("encounterName")=$$NAME^VPRDJ04(VISIT)
+14 SET X0=$GET(^AUPNVSIT(+VISIT,0))
SET FAC=+$PIECE(X0,U,6)
SET LOC=+$PIECE(X0,U,22)
+15 if FAC
SET X=$$STA^XUAF4(FAC)_U_$PIECE($$NS^XUAF4(FAC),U)
+16 if 'FAC
SET X=$$FAC^VPRD(LOC)
+17 DO FACILITY^VPRUTILS(X,"PCE")
+18 if LOC
SET PCE("locationUid")=$$SETUID^VPRUTILS("location",,LOC)
SET PCE("locationName")=$PIECE($GET(^SC(LOC,0)),U)
+19 SET X=$GET(VPRF("COMMENTS"))
if $LENGTH(X)
SET PCE("comment")=X
POV IF FNUM=9000010.07
Begin DoDot:1
+1 SET X=$GET(VPRF("PRIMARY/SECONDARY"))
SET PCE("type")=$SELECT($LENGTH(X):X,1:"U")
+2 ;coding system
SET Y=$$LOW^XLFSTR($PIECE(TMP,U,3))
+3 SET X=PCE("name")
SET PCE("icdCode")=$$SETNCS^VPRUTILS(Y,X)
+4 SET X=$GET(VPRF("PROVIDER NARRATIVE"))
SET PCE("name")=$$EXTERNAL^DILFD(9000010.07,.04,,X)
End DoDot:1
GOTO PXQ
CPT IF FNUM=9000010.18
Begin DoDot:1
+1 SET X=$GET(VPRF("PRINCIPAL PROCEDURE"))
SET PCE("type")=$SELECT($LENGTH(X):X,1:"U")
+2 SET X=PCE("name")
SET PCE("cptCode")=$$SETNCS^VPRUTILS("cpt",X)
+3 SET X=$GET(VPRF("PROVIDER NARRATIVE"))
SET PCE("name")=$$EXTERNAL^DILFD(9000010.18,.04,,X)
+4 SET PCE("quantity")=VPRF("QUANTITY")
End DoDot:1
GOTO PXQ
+5 SET X=$GET(VPRF("VALUE"))
SET FLD=$SELECT(FNUM=9000010.16:.06,1:.04)
+6 SET Y=$$EXTERNAL^DILFD(FNUM,FLD,,X)
IM ;immunization
IF FNUM=9000010.11
Begin DoDot:1
+1 if $LENGTH(Y)
SET PCE("seriesName")=Y
SET PCE("seriesCode")=$$SETUID^VPRUTILS("series",DFN,Y)
+2 SET X=$GET(VPRF("REACTION"))
IF $LENGTH(X)
Begin DoDot:2
+3 SET PCE("reactionName")=$$EXTERNAL^DILFD(9000010.11,.06,,X)
+4 SET PCE("reactionCode")=$$SETUID^VPRUTILS("reaction",DFN,X)
End DoDot:2
+5 SET PCE("contraindicated")=$SELECT(+$GET(VPRF("CONTRAINDICATED")):"true",1:"false")
+6 IF '$DATA(^TMP("PXKENC",$JOB,VISIT))
DO ENCEVENT^PXAPI(VISIT,1)
+7 SET X12=$GET(^TMP("PXKENC",$JOB,VISIT,"IMM",ID,12))
+8 SET X=$PIECE(X12,U,4)
if 'X
SET X=$PIECE(X12,U,2)
+9 IF 'X
SET I=0
FOR
SET I=$ORDER(^TMP("PXKENC",$JOB,VISIT,"PRV",I))
if I<1
QUIT
IF $PIECE($GET(^(I,0)),U,4)="P"
SET X=+^(0)
QUIT
+10 if X
SET PCE("performerUid")=$$SETUID^VPRUTILS("user",,+X)
SET PCE("performerName")=$PIECE($GET(^VA(200,X,0)),U)
+11 ; CPT mapping
+12 SET X=+$$FIND1^DIC(811.1,,"QX",+TMP_";AUTTIMM(","B")
IF X>0
Begin DoDot:2
+13 SET Y=$$GET1^DIQ(811.1,X_",",.02,"I")
if Y<1
QUIT
+14 NEW CPT
SET CPT=$GET(@(U_$PIECE(Y,";",2)_+Y_",0)"))
+15 SET PCE("cptCode")=$$SETNCS^VPRUTILS("cpt",+CPT)
+16 SET (PCE("summary"),PCE("cptName"))=$PIECE(CPT,U,2)
End DoDot:2
End DoDot:1
GOTO PXQ
HF ;health factor
IF FNUM=9000010.23
Begin DoDot:1
+1 if $LENGTH(X)
SET PCE("severityUid")=$$SETVURN^VPRUTILS("factor-severity",X)
SET PCE("severityName")=$$LOWER^VALM1(Y)
+2 SET X=$$GET1^DIQ(9999999.64,+TMP_",",.03,"I")
IF X
Begin DoDot:2
+3 SET PCE("categoryUid")=$$SETVURN^VPRUTILS("factor-category",X)
+4 SET PCE("categoryName")=$$EXTERNAL^DILFD(9999999.64,.03,"",X)
End DoDot:2
+5 SET X=$$GET1^DIQ(9999999.64,+TMP_",",.08)
+6 IF $EXTRACT(X)="Y"
SET PCE("display")="true"
+7 SET PCE("kind")="Health Factor"
SET PCE("summary")=PCE("name")
End DoDot:1
GOTO PXQ
SK ;skin test [fall thru to set result]
IF FNUM=9000010.12
Begin DoDot:1
+1 SET X=$GET(VPRF("READING"))
if $LENGTH(X)
SET PCE("reading")=X
+2 SET X=$GET(VPRF("DATE READ"))
if X
SET PCE("dateRead")=$$JSONDT^VPRUTILS(X)
End DoDot:1
+3 if $LENGTH(Y)
SET PCE("result")=Y
PXQ ;finish
+1 DO ADD^VPRDJ("PCE",COLL)
+2 QUIT
+3 ;
SORT ; -- build ^TMP("VPRPX",$J,9999999-DATE,DA)=ITEM^DATE^[SYS] in range
+1 ; Expects VPRSTART and VPRSTOP
+2 NEW TYPE,ITEM,DATE,DA,IDT,SYS
KILL ^TMP("VPRPX",$JOB)
+3 IF FNUM=9000010.07!(FNUM=9000010.18)
Begin DoDot:1
+4 NEW INDEX
+5 SET INDEX=$NAME(^PXRMINDX(FNUM))
DO PPI(INDEX)
+6 IF FNUM=9000010.07
SET INDEX=$NAME(^PXRMINDX(FNUM,"10D"))
DO PPI(INDEX)
End DoDot:1
QUIT
PI ; from ^PXRMINDX(FNUM,"PI",DFN,ITEM,DATE,DA)
+1 SET ITEM=0
FOR
SET ITEM=$ORDER(^PXRMINDX(FNUM,"PI",+$GET(DFN),ITEM))
if ITEM<1
QUIT
Begin DoDot:1
+2 SET DATE=0
FOR
SET DATE=$ORDER(^PXRMINDX(FNUM,"PI",+$GET(DFN),ITEM,DATE))
if DATE<1
QUIT
Begin DoDot:2
+3 if DATE<VPRSTART
QUIT
if DATE>VPRSTOP
QUIT
SET IDT=9999999-DATE
+4 SET DA=0
FOR
SET DA=$ORDER(^PXRMINDX(FNUM,"PI",+$GET(DFN),ITEM,DATE,DA))
if DA<1
QUIT
SET ^TMP("VPRPX",$JOB,IDT,DA)=ITEM_U_DATE
End DoDot:2
End DoDot:1
+5 QUIT
PPI(INDX) ; from ^PXRMINDX(FNUM,["10D",]"PPI",DFN,TYPE,ITEM,DATE,DA)
+1 SET TYPE=""
FOR
SET TYPE=$ORDER(@INDX@("PPI",+$GET(DFN),TYPE))
if TYPE=""
QUIT
Begin DoDot:1
+2 SET ITEM=""
FOR
SET ITEM=$ORDER(@INDX@("PPI",+$GET(DFN),TYPE,ITEM))
if ITEM=""
QUIT
Begin DoDot:2
+3 SET DATE=0
FOR
SET DATE=$ORDER(@INDX@("PPI",+$GET(DFN),TYPE,ITEM,DATE))
if DATE<1
QUIT
Begin DoDot:3
+4 if DATE<VPRSTART
QUIT
if DATE>VPRSTOP
QUIT
SET IDT=9999999-DATE
+5 SET SYS=$SELECT(INDX["10D":"10D",INDX[".07":"ICD",1:"CPT")
+6 SET DA=0
FOR
SET DA=$ORDER(@INDX@("PPI",+$GET(DFN),TYPE,ITEM,DATE,DA))
if DA<1
QUIT
SET ^TMP("VPRPX",$JOB,IDT,DA)=ITEM_U_DATE_U_SYS
End DoDot:3
End DoDot:2
End DoDot:1
+7 QUIT
PTF ; from ^PXRMINDX(45,"ICD","PNI",DFN,TYPE,ITEM,DATE,DA)
+1 ; Expects VPRSTART and VPRSTOP
+2 NEW SYS,TYPE,ITEM,DATE,IDT,DA
+3 FOR SYS="ICD","10D"
Begin DoDot:1
+4 SET TYPE=""
FOR
SET TYPE=$ORDER(^PXRMINDX(45,SYS,"PNI",+$GET(DFN),TYPE))
if TYPE=""
QUIT
Begin DoDot:2
+5 SET ITEM=0
FOR
SET ITEM=$ORDER(^PXRMINDX(45,SYS,"PNI",+$GET(DFN),TYPE,ITEM))
if ITEM<1
QUIT
Begin DoDot:3
+6 SET DATE=0
FOR
SET DATE=$ORDER(^PXRMINDX(45,SYS,"PNI",+$GET(DFN),TYPE,ITEM,DATE))
if DATE<1
QUIT
Begin DoDot:4
+7 if DATE<VPRSTART
QUIT
if DATE>VPRSTOP
QUIT
SET IDT=9999999-DATE
+8 SET DA=""
FOR
SET DA=$ORDER(^PXRMINDX(45,SYS,"PNI",+$GET(DFN),TYPE,ITEM,DATE,DA))
if DA=""
QUIT
SET ^TMP("VPRPX",$JOB,IDT,DA_";"_TYPE)=ITEM_U_DATE_U_SYS
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+9 QUIT
