- 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 Mar 13, 2025@21:49:47 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
