- PXBSTOR ;ISL/JVS - PASSING THE DATA TO THE V FILES ;3/21/05 1:35pm
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**73,88,149,124,164,203,199**;Aug 12, 1996;Build 51
- ;
- ; VARIABLE LIST
- ; PIECE 1 2 3 4 5 6 7 8 9
- ; REQ*=PROVDER^PRIMARY^CPT^QUANTITY^POV^PRIMARY^PRV IEN^CPT IEN^POV IEN
- ; PIECE 10 11 12 13 14 15 16 17 18 19 20 21 22
- ; REQ STOPCODE^STOPCODE IEN^DX1^DX2^DX3^DX4^DX5^DX6^DX7^DX8^DEPT CODE^^OrdPrv
- ; (DX5 - DX10 for future use)
- ; REQ(1,MODIFIER)*=""
- ; REQ("IEN")=V CPT file IEN
- ; REQI=Internal Values
- ; REQE=External Values
- ; PXBVST=Visit Ien
- ; PRVIEN=Provider IEN in V Provider file
- ; CPTIEN=CPT IEN in V CPT file
- ; POVIEN=POV IEN in V POV file
- ; patient is defined from the visit
- ;
- EN0(PXBVST,PATIENT,REQI,REQ) ;--Main Entry point
- EN1 ;
- Q:'$D(REQI)!$G(PXBVST)<1
- K ^TMP("PXK",$J) ;--MUST BE MOVED TO AFTER THE EVENT
- N CPRNARR,CPTAF812,CPTAFT,CPTAFT1,CPTAFT12,CPTBEF,CPTBEF1,CPTBEF12
- N CPTBF812,CPTIEN,CTR,POVAF800,POVAF812,POVAFT,POVAFT12,POVBEF
- N POVBEF12,POVBF800,POVBF812,POVI,POVIEN,PPRNARR,PRVAF812,PRVAFT
- N PRVAFT12,PRVBEF,PRVBEF12,PRVBF812,PRVIEN,SEQ
- ;
- SET ;--SET TEMP GLOBALS
- S SEQ=$$SET^PXBSTOR1
- I $G(IDATE)="" S IDATE=+^AUPNVSIT(PXBVST,0)
- D:$P(REQI,"^",1) PRV S SEQ=SEQ+1
- D:$P(REQI,"^",3) CPT S SEQ=SEQ+1
- D:$P(REQI,"^",5) POV S SEQ=SEQ+1
- F CTR=12:1:19 D:$P(REQI,U,CTR) DX S SEQ=SEQ+1
- S ^TMP("PXBSTOR",$J,"SEQ")=SEQ+1
- Q
- PRV ;--PROVIDER PIECE 1 AND 2
- S PRVAFT=PRVBEF,PRVAFT12=PRVBEF12,PRVAF812=PRVBF812
- I $D(DELM),$P(DELM,"^",1)=1 S (PRVAFT,PRVAFT12)="" G PRV1
- S $P(PRVAFT,"^",1)=$P(REQI,"^",1) ;--PROVIDER IEN
- S $P(PRVAFT,"^",4)=$P(REQI,"^",2) ;--PRIMARY/SECONDARY
- S $P(PRVAFT,"^",2)=PATIENT ;--PATIENT
- S $P(PRVAFT,"^",3)=PXBVST ;--VISIT POINTER
- I PRVBF812']"" D
- .;-***POPULATE VERIFIED FIELD IN FUTURE
- .S $P(PRVAF812,"^",2)=$G(PXBPKG)
- .S $P(PRVAF812,"^",3)=$G(PXBSOURC)
- PRV1 S ^TMP("PXK",$J,"PRV",SEQ,0,"AFTER")=PRVAFT
- S ^TMP("PXK",$J,"PRV",SEQ,0,"BEFORE")=PRVBEF
- S ^TMP("PXK",$J,"PRV",SEQ,12,"AFTER")=PRVAFT12
- S ^TMP("PXK",$J,"PRV",SEQ,12,"BEFORE")=PRVBEF12
- S ^TMP("PXK",$J,"PRV",SEQ,812,"AFTER")=PRVAF812
- S ^TMP("PXK",$J,"PRV",SEQ,812,"BEFORE")=PRVBF812
- S ^TMP("PXK",$J,"PRV",SEQ,"IEN")=PRVIEN
- Q
- ;
- CPT ;--CPT PROCDEURE PIECE 3 AND 4
- N PXMODIEN
- S CPTAFT=CPTBEF,CPTAFT12=CPTBEF12,CPTAF812=CPTBF812
- I $D(DELM),$P(DELM,"^",2)=1 S (CPTAFT,CPTAFT12)="" G CPT1
- S $P(CPTAFT,"^",1)=$P(REQI,"^",3) ;--PROCEDURE IEN
- S $P(CPTAFT,"^",2)=PATIENT ;--PATIENT
- S $P(CPTAFT,"^",3)=PXBVST ;--VISIT POINTER
- S $P(CPTAFT12,"^",4)=$P(REQI,"^",1) ;--PROVIDER POINTER
- S $P(CPTAFT12,"^",2)=$P(REQI,"^",22) ;--ORDERING PROVIDER POINTER
- S CPRNARR=$P($$CPT^ICPTCOD($P(REQI,"^",3),$G(IDATE)),U,3) ;--TEXT PROV NARR
- S $P(CPTAFT,"^",4)=+$$PROVNARR^PXAPI($G(CPRNARR),9000010.18) ;--PROV NAR
- S $P(CPTAFT,"^",16)=$P(REQI,"^",4) ;--QUANTITY
- S $P(CPTAFT,"^",5)=$P(REQI,"^",12) ;DX1 (REQUIRED)
- S $P(REQI,U,19)=$P(REQI,U,19) ;INSURE AT LEAST 19 PIECES IN REQI
- S $P(CPTAFT,"^",9,15)=$P(REQI,"^",13,19) ;DX2 - DX4, DX5 - DX8
- I $$SWSTAT^IBBAPI() D ;DEPARTMENT CODE
- . I $P(CPTAFT,U,19)="",$G(^AUPNVSIT(PXBVST,0)),$P(^AUPNVSIT(PXBVST,0),"^",8) S $P(CPTAFT,U,19)=$P($G(^DIC(40.7,$P(^AUPNVSIT(PXBVST,0),"^",8),0)),"^",2)
- I $P(REQI,"^",4)=0 S (CPTAFT,CPTAFT12)=""
- I $P(REQI,"^",4)="@" S (CPTAFT,CPTAFT12)=""
- ;--------------------
- ;I $G(CPTIEN),$D(^AUPNVCPT(CPTIEN,12)),$P(REQI,"^",1)'=$P(^AUPNVCPT(CPTIEN,12),"^",4),'$D(DELM) S (CPTIEN,CPTBEF,CPTBEF12)=""
- ;---------------
- I CPTBF812']"" D
- .;-***POPULATE VERIFIED FIELD IN FUTURE
- .S $P(CPTAF812,"^",2)=$G(PXBPKG)
- .S $P(CPTAF812,"^",3)=$G(PXBSOURC)
- S PXMODIEN=""
- F S PXMODIEN=$O(REQ(1,PXMODIEN)) Q:PXMODIEN="" D
- .S CPTAFT1(PXMODIEN)=REQ(1,PXMODIEN)
- CPT1 ;
- S ^TMP("PXK",$J,"CPT",SEQ,0,"AFTER")=CPTAFT
- S ^TMP("PXK",$J,"CPT",SEQ,0,"BEFORE")=CPTBEF
- S ^TMP("PXK",$J,"CPT",SEQ,12,"AFTER")=CPTAFT12
- S ^TMP("PXK",$J,"CPT",SEQ,12,"BEFORE")=CPTBEF12
- S ^TMP("PXK",$J,"CPT",SEQ,812,"AFTER")=CPTAF812
- S ^TMP("PXK",$J,"CPT",SEQ,812,"BEFORE")=CPTBF812
- S ^TMP("PXK",$J,"CPT",SEQ,"IEN")=CPTIEN
- ;Set modifiers into ^TMP
- S PXMODIEN=""
- F S PXMODIEN=$O(CPTAFT1(PXMODIEN)) Q:PXMODIEN="" D
- .S ^TMP("PXK",$J,"CPT",SEQ,1,PXMODIEN,"AFTER")=CPTAFT1(PXMODIEN)
- S PXMODIEN=""
- F S PXMODIEN=$O(CPTBEF1(PXMODIEN)) Q:PXMODIEN="" D
- .S ^TMP("PXK",$J,"CPT",SEQ,1,PXMODIEN,"BEFORE")=CPTBEF1(PXMODIEN)
- ;Set ^TMP file with V CPT IEN
- I $G(REQ)]"" D
- . S ^TMP("PXK",$J,"CPT",SEQ,"IEN")=REQ
- Q
- ;
- POV ;--POV PIECE 5 AND 6
- S POVAFT=POVBEF,POVAFT12=POVBEF12,POVAF812=POVBF812,POVAF800=POVBF800
- S POVAFT17=POVBEF17
- I $D(DELM),$P(DELM,"^",3)=1 S (POVAFT,POVAFT12,POVAF800)="" G POV1
- S $P(POVAFT,"^",1)=$P(REQI,"^",5) ;--POV IEN
- S $P(POVAFT,"^",12)=$P(REQI,"^",6) ;--PRI/SECONDARY
- S $P(POVAFT,U,17)=$P(REQI,U,7) ;--ORDERING/RESULTING
- S $P(POVAFT,"^",2)=PATIENT ;--PATIENT
- S $P(POVAFT,"^",3)=PXBVST ;--VISIT POINTER
- S PPRNARR=$$DXNARR^PXUTL1($P(REQI,"^",5),$$CSDATE^PXDXUTL(PXBVST)) ;--TEXT PROV NARR
- S $P(POVAFT,"^",4)=+$$PROVNARR^PXAPI($G(PPRNARR),9000010.07) ;--POI PROV NARR
- I $P($G(REQI),"^",7) S $P(POVAFT12,"^",4)=$P(^AUPNVPRV($P(REQI,"^",7),0),"^",1) ;--PROVIDER
- I $G(PXBRES) S $P(POVAFT,"^",16)=PXBRES ;-PROBLEM LIST ENTRY
- I POVBF812']"" D
- .;-**POPULATE VERIFIED FIELD IN FUTURE
- .S $P(POVAF812,"^",2)=$G(PXBPKG)
- .S $P(POVAF812,"^",3)=$G(PXBSOURC)
- I $D(PXBREQ($P(REQI,U,5))) S POVAF800=$G(PXBREQ($P(REQI,U,5),"I"))
- POV1 S ^TMP("PXK",$J,"POV",SEQ,0,"AFTER")=POVAFT
- S ^TMP("PXK",$J,"POV",SEQ,0,"BEFORE")=POVBEF
- S ^TMP("PXK",$J,"POV",SEQ,12,"AFTER")=POVAFT12
- S ^TMP("PXK",$J,"POV",SEQ,12,"BEFORE")=POVBEF12
- S ^TMP("PXK",$J,"POV",SEQ,17,"AFTER")=POVAFT17
- S ^TMP("PXK",$J,"POV",SEQ,17,"BEFORE")=POVBEF17
- S ^TMP("PXK",$J,"POV",SEQ,812,"AFTER")=POVAF812
- S ^TMP("PXK",$J,"POV",SEQ,812,"BEFORE")=POVBF812
- S ^TMP("PXK",$J,"POV",SEQ,800,"AFTER")=POVAF800
- S ^TMP("PXK",$J,"POV",SEQ,800,"BEFORE")=POVBF800
- S ^TMP("PXK",$J,"POV",SEQ,"IEN")=POVIEN
- Q
- ;
- DX ;CPT DIAGNOSIS - PX124
- N POVIEN,POVBF800,POVBF812,POVBEF12,POVBEF,POVBEF17,PXBVDT
- N IEN,ANS,POVAF800,POVAF812,POVAFT12,POVAFT,POVAFT17
- S IEN=$P(REQI,U,CTR),ANS=$$XLATE^PXBGPOV(PXBVST,IEN),POVIEN=+ANS
- I POVIEN D
- .S POVBEF=$G(^AUPNVPOV(POVIEN,0)),POVBEF12=$G(^(12)),POVBF812=$G(^(812)),POVBF800=$G(^(800)),POVBEF17=$G(^(17))
- E S (POVBF800,POVBF812,POVBEF12,POVBEF17,POVBEF)=""
- S POVAFT=POVBEF,POVAFT12=POVBEF12,POVAF812=POVBF812,POVAF800=POVBF800
- S POVAFT17=POVBEF17
- S $P(POVAFT,U,1,3)=IEN_U_PATIENT_U_PXBVST
- S PXBVDT=$$CSDATE^PXDXUTL(PXBVST) ; get visit date
- S PPRNARR=$$DXNARR^PXUTL1(IEN,PXBVDT) ; get diagnosis description
- S $P(POVAFT,U,4)=+$$PROVNARR^PXAPI(PPRNARR,9000010.07)
- S $P(POVAFT,U,12)=$S(IEN=$G(PXBDXPRI):"P",1:"S") ;PRI/SEC
- I $P(REQI,U,7) S $P(POVAFT12,U,4)=$P($G(^AUPNVPRV($P(REQI,U,7),0)),U,1)
- I POVBF812']"" S $P(POVAF812,U,2,3)=$G(PXBPKG)_U_$G(PXBSOURC)
- S POVAF800=$G(PXBREQ(IEN,"I")) S:POVAF800="" POVAF800=$P(ANS,U,4,20)
- D POV1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBSTOR 7082 printed Jan 18, 2025@03:28:18 Page 2
- PXBSTOR ;ISL/JVS - PASSING THE DATA TO THE V FILES ;3/21/05 1:35pm
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**73,88,149,124,164,203,199**;Aug 12, 1996;Build 51
- +2 ;
- +3 ; VARIABLE LIST
- +4 ; PIECE 1 2 3 4 5 6 7 8 9
- +5 ; REQ*=PROVDER^PRIMARY^CPT^QUANTITY^POV^PRIMARY^PRV IEN^CPT IEN^POV IEN
- +6 ; PIECE 10 11 12 13 14 15 16 17 18 19 20 21 22
- +7 ; REQ STOPCODE^STOPCODE IEN^DX1^DX2^DX3^DX4^DX5^DX6^DX7^DX8^DEPT CODE^^OrdPrv
- +8 ; (DX5 - DX10 for future use)
- +9 ; REQ(1,MODIFIER)*=""
- +10 ; REQ("IEN")=V CPT file IEN
- +11 ; REQI=Internal Values
- +12 ; REQE=External Values
- +13 ; PXBVST=Visit Ien
- +14 ; PRVIEN=Provider IEN in V Provider file
- +15 ; CPTIEN=CPT IEN in V CPT file
- +16 ; POVIEN=POV IEN in V POV file
- +17 ; patient is defined from the visit
- +18 ;
- EN0(PXBVST,PATIENT,REQI,REQ) ;--Main Entry point
- EN1 ;
- +1 if '$DATA(REQI)!$GET(PXBVST)<1
- QUIT
- +2 ;--MUST BE MOVED TO AFTER THE EVENT
- KILL ^TMP("PXK",$JOB)
- +3 NEW CPRNARR,CPTAF812,CPTAFT,CPTAFT1,CPTAFT12,CPTBEF,CPTBEF1,CPTBEF12
- +4 NEW CPTBF812,CPTIEN,CTR,POVAF800,POVAF812,POVAFT,POVAFT12,POVBEF
- +5 NEW POVBEF12,POVBF800,POVBF812,POVI,POVIEN,PPRNARR,PRVAF812,PRVAFT
- +6 NEW PRVAFT12,PRVBEF,PRVBEF12,PRVBF812,PRVIEN,SEQ
- +7 ;
- SET ;--SET TEMP GLOBALS
- +1 SET SEQ=$$SET^PXBSTOR1
- +2 IF $GET(IDATE)=""
- SET IDATE=+^AUPNVSIT(PXBVST,0)
- +3 if $PIECE(REQI,"^",1)
- DO PRV
- SET SEQ=SEQ+1
- +4 if $PIECE(REQI,"^",3)
- DO CPT
- SET SEQ=SEQ+1
- +5 if $PIECE(REQI,"^",5)
- DO POV
- SET SEQ=SEQ+1
- +6 FOR CTR=12:1:19
- if $PIECE(REQI,U,CTR)
- DO DX
- SET SEQ=SEQ+1
- +7 SET ^TMP("PXBSTOR",$JOB,"SEQ")=SEQ+1
- +8 QUIT
- PRV ;--PROVIDER PIECE 1 AND 2
- +1 SET PRVAFT=PRVBEF
- SET PRVAFT12=PRVBEF12
- SET PRVAF812=PRVBF812
- +2 IF $DATA(DELM)
- IF $PIECE(DELM,"^",1)=1
- SET (PRVAFT,PRVAFT12)=""
- GOTO PRV1
- +3 ;--PROVIDER IEN
- SET $PIECE(PRVAFT,"^",1)=$PIECE(REQI,"^",1)
- +4 ;--PRIMARY/SECONDARY
- SET $PIECE(PRVAFT,"^",4)=$PIECE(REQI,"^",2)
- +5 ;--PATIENT
- SET $PIECE(PRVAFT,"^",2)=PATIENT
- +6 ;--VISIT POINTER
- SET $PIECE(PRVAFT,"^",3)=PXBVST
- +7 IF PRVBF812']""
- Begin DoDot:1
- +8 ;-***POPULATE VERIFIED FIELD IN FUTURE
- +9 SET $PIECE(PRVAF812,"^",2)=$GET(PXBPKG)
- +10 SET $PIECE(PRVAF812,"^",3)=$GET(PXBSOURC)
- End DoDot:1
- PRV1 SET ^TMP("PXK",$JOB,"PRV",SEQ,0,"AFTER")=PRVAFT
- +1 SET ^TMP("PXK",$JOB,"PRV",SEQ,0,"BEFORE")=PRVBEF
- +2 SET ^TMP("PXK",$JOB,"PRV",SEQ,12,"AFTER")=PRVAFT12
- +3 SET ^TMP("PXK",$JOB,"PRV",SEQ,12,"BEFORE")=PRVBEF12
- +4 SET ^TMP("PXK",$JOB,"PRV",SEQ,812,"AFTER")=PRVAF812
- +5 SET ^TMP("PXK",$JOB,"PRV",SEQ,812,"BEFORE")=PRVBF812
- +6 SET ^TMP("PXK",$JOB,"PRV",SEQ,"IEN")=PRVIEN
- +7 QUIT
- +8 ;
- CPT ;--CPT PROCDEURE PIECE 3 AND 4
- +1 NEW PXMODIEN
- +2 SET CPTAFT=CPTBEF
- SET CPTAFT12=CPTBEF12
- SET CPTAF812=CPTBF812
- +3 IF $DATA(DELM)
- IF $PIECE(DELM,"^",2)=1
- SET (CPTAFT,CPTAFT12)=""
- GOTO CPT1
- +4 ;--PROCEDURE IEN
- SET $PIECE(CPTAFT,"^",1)=$PIECE(REQI,"^",3)
- +5 ;--PATIENT
- SET $PIECE(CPTAFT,"^",2)=PATIENT
- +6 ;--VISIT POINTER
- SET $PIECE(CPTAFT,"^",3)=PXBVST
- +7 ;--PROVIDER POINTER
- SET $PIECE(CPTAFT12,"^",4)=$PIECE(REQI,"^",1)
- +8 ;--ORDERING PROVIDER POINTER
- SET $PIECE(CPTAFT12,"^",2)=$PIECE(REQI,"^",22)
- +9 ;--TEXT PROV NARR
- SET CPRNARR=$PIECE($$CPT^ICPTCOD($PIECE(REQI,"^",3),$GET(IDATE)),U,3)
- +10 ;--PROV NAR
- SET $PIECE(CPTAFT,"^",4)=+$$PROVNARR^PXAPI($GET(CPRNARR),9000010.18)
- +11 ;--QUANTITY
- SET $PIECE(CPTAFT,"^",16)=$PIECE(REQI,"^",4)
- +12 ;DX1 (REQUIRED)
- SET $PIECE(CPTAFT,"^",5)=$PIECE(REQI,"^",12)
- +13 ;INSURE AT LEAST 19 PIECES IN REQI
- SET $PIECE(REQI,U,19)=$PIECE(REQI,U,19)
- +14 ;DX2 - DX4, DX5 - DX8
- SET $PIECE(CPTAFT,"^",9,15)=$PIECE(REQI,"^",13,19)
- +15 ;DEPARTMENT CODE
- IF $$SWSTAT^IBBAPI()
- Begin DoDot:1
- +16 IF $PIECE(CPTAFT,U,19)=""
- IF $GET(^AUPNVSIT(PXBVST,0))
- IF $PIECE(^AUPNVSIT(PXBVST,0),"^",8)
- SET $PIECE(CPTAFT,U,19)=$PIECE($GET(^DIC(40.7,$PIECE(^AUPNVSIT(PXBVST,0),"^",8),0)),"^",2)
- End DoDot:1
- +17 IF $PIECE(REQI,"^",4)=0
- SET (CPTAFT,CPTAFT12)=""
- +18 IF $PIECE(REQI,"^",4)="@"
- SET (CPTAFT,CPTAFT12)=""
- +19 ;--------------------
- +20 ;I $G(CPTIEN),$D(^AUPNVCPT(CPTIEN,12)),$P(REQI,"^",1)'=$P(^AUPNVCPT(CPTIEN,12),"^",4),'$D(DELM) S (CPTIEN,CPTBEF,CPTBEF12)=""
- +21 ;---------------
- +22 IF CPTBF812']""
- Begin DoDot:1
- +23 ;-***POPULATE VERIFIED FIELD IN FUTURE
- +24 SET $PIECE(CPTAF812,"^",2)=$GET(PXBPKG)
- +25 SET $PIECE(CPTAF812,"^",3)=$GET(PXBSOURC)
- End DoDot:1
- +26 SET PXMODIEN=""
- +27 FOR
- SET PXMODIEN=$ORDER(REQ(1,PXMODIEN))
- if PXMODIEN=""
- QUIT
- Begin DoDot:1
- +28 SET CPTAFT1(PXMODIEN)=REQ(1,PXMODIEN)
- End DoDot:1
- CPT1 ;
- +1 SET ^TMP("PXK",$JOB,"CPT",SEQ,0,"AFTER")=CPTAFT
- +2 SET ^TMP("PXK",$JOB,"CPT",SEQ,0,"BEFORE")=CPTBEF
- +3 SET ^TMP("PXK",$JOB,"CPT",SEQ,12,"AFTER")=CPTAFT12
- +4 SET ^TMP("PXK",$JOB,"CPT",SEQ,12,"BEFORE")=CPTBEF12
- +5 SET ^TMP("PXK",$JOB,"CPT",SEQ,812,"AFTER")=CPTAF812
- +6 SET ^TMP("PXK",$JOB,"CPT",SEQ,812,"BEFORE")=CPTBF812
- +7 SET ^TMP("PXK",$JOB,"CPT",SEQ,"IEN")=CPTIEN
- +8 ;Set modifiers into ^TMP
- +9 SET PXMODIEN=""
- +10 FOR
- SET PXMODIEN=$ORDER(CPTAFT1(PXMODIEN))
- if PXMODIEN=""
- QUIT
- Begin DoDot:1
- +11 SET ^TMP("PXK",$JOB,"CPT",SEQ,1,PXMODIEN,"AFTER")=CPTAFT1(PXMODIEN)
- End DoDot:1
- +12 SET PXMODIEN=""
- +13 FOR
- SET PXMODIEN=$ORDER(CPTBEF1(PXMODIEN))
- if PXMODIEN=""
- QUIT
- Begin DoDot:1
- +14 SET ^TMP("PXK",$JOB,"CPT",SEQ,1,PXMODIEN,"BEFORE")=CPTBEF1(PXMODIEN)
- End DoDot:1
- +15 ;Set ^TMP file with V CPT IEN
- +16 IF $GET(REQ)]""
- Begin DoDot:1
- +17 SET ^TMP("PXK",$JOB,"CPT",SEQ,"IEN")=REQ
- End DoDot:1
- +18 QUIT
- +19 ;
- POV ;--POV PIECE 5 AND 6
- +1 SET POVAFT=POVBEF
- SET POVAFT12=POVBEF12
- SET POVAF812=POVBF812
- SET POVAF800=POVBF800
- +2 SET POVAFT17=POVBEF17
- +3 IF $DATA(DELM)
- IF $PIECE(DELM,"^",3)=1
- SET (POVAFT,POVAFT12,POVAF800)=""
- GOTO POV1
- +4 ;--POV IEN
- SET $PIECE(POVAFT,"^",1)=$PIECE(REQI,"^",5)
- +5 ;--PRI/SECONDARY
- SET $PIECE(POVAFT,"^",12)=$PIECE(REQI,"^",6)
- +6 ;--ORDERING/RESULTING
- SET $PIECE(POVAFT,U,17)=$PIECE(REQI,U,7)
- +7 ;--PATIENT
- SET $PIECE(POVAFT,"^",2)=PATIENT
- +8 ;--VISIT POINTER
- SET $PIECE(POVAFT,"^",3)=PXBVST
- +9 ;--TEXT PROV NARR
- SET PPRNARR=$$DXNARR^PXUTL1($PIECE(REQI,"^",5),$$CSDATE^PXDXUTL(PXBVST))
- +10 ;--POI PROV NARR
- SET $PIECE(POVAFT,"^",4)=+$$PROVNARR^PXAPI($GET(PPRNARR),9000010.07)
- +11 ;--PROVIDER
- IF $PIECE($GET(REQI),"^",7)
- SET $PIECE(POVAFT12,"^",4)=$PIECE(^AUPNVPRV($PIECE(REQI,"^",7),0),"^",1)
- +12 ;-PROBLEM LIST ENTRY
- IF $GET(PXBRES)
- SET $PIECE(POVAFT,"^",16)=PXBRES
- +13 IF POVBF812']""
- Begin DoDot:1
- +14 ;-**POPULATE VERIFIED FIELD IN FUTURE
- +15 SET $PIECE(POVAF812,"^",2)=$GET(PXBPKG)
- +16 SET $PIECE(POVAF812,"^",3)=$GET(PXBSOURC)
- End DoDot:1
- +17 IF $DATA(PXBREQ($PIECE(REQI,U,5)))
- SET POVAF800=$GET(PXBREQ($PIECE(REQI,U,5),"I"))
- POV1 SET ^TMP("PXK",$JOB,"POV",SEQ,0,"AFTER")=POVAFT
- +1 SET ^TMP("PXK",$JOB,"POV",SEQ,0,"BEFORE")=POVBEF
- +2 SET ^TMP("PXK",$JOB,"POV",SEQ,12,"AFTER")=POVAFT12
- +3 SET ^TMP("PXK",$JOB,"POV",SEQ,12,"BEFORE")=POVBEF12
- +4 SET ^TMP("PXK",$JOB,"POV",SEQ,17,"AFTER")=POVAFT17
- +5 SET ^TMP("PXK",$JOB,"POV",SEQ,17,"BEFORE")=POVBEF17
- +6 SET ^TMP("PXK",$JOB,"POV",SEQ,812,"AFTER")=POVAF812
- +7 SET ^TMP("PXK",$JOB,"POV",SEQ,812,"BEFORE")=POVBF812
- +8 SET ^TMP("PXK",$JOB,"POV",SEQ,800,"AFTER")=POVAF800
- +9 SET ^TMP("PXK",$JOB,"POV",SEQ,800,"BEFORE")=POVBF800
- +10 SET ^TMP("PXK",$JOB,"POV",SEQ,"IEN")=POVIEN
- +11 QUIT
- +12 ;
- DX ;CPT DIAGNOSIS - PX124
- +1 NEW POVIEN,POVBF800,POVBF812,POVBEF12,POVBEF,POVBEF17,PXBVDT
- +2 NEW IEN,ANS,POVAF800,POVAF812,POVAFT12,POVAFT,POVAFT17
- +3 SET IEN=$PIECE(REQI,U,CTR)
- SET ANS=$$XLATE^PXBGPOV(PXBVST,IEN)
- SET POVIEN=+ANS
- +4 IF POVIEN
- Begin DoDot:1
- +5 SET POVBEF=$GET(^AUPNVPOV(POVIEN,0))
- SET POVBEF12=$GET(^(12))
- SET POVBF812=$GET(^(812))
- SET POVBF800=$GET(^(800))
- SET POVBEF17=$GET(^(17))
- End DoDot:1
- +6 IF '$TEST
- SET (POVBF800,POVBF812,POVBEF12,POVBEF17,POVBEF)=""
- +7 SET POVAFT=POVBEF
- SET POVAFT12=POVBEF12
- SET POVAF812=POVBF812
- SET POVAF800=POVBF800
- +8 SET POVAFT17=POVBEF17
- +9 SET $PIECE(POVAFT,U,1,3)=IEN_U_PATIENT_U_PXBVST
- +10 ; get visit date
- SET PXBVDT=$$CSDATE^PXDXUTL(PXBVST)
- +11 ; get diagnosis description
- SET PPRNARR=$$DXNARR^PXUTL1(IEN,PXBVDT)
- +12 SET $PIECE(POVAFT,U,4)=+$$PROVNARR^PXAPI(PPRNARR,9000010.07)
- +13 ;PRI/SEC
- SET $PIECE(POVAFT,U,12)=$SELECT(IEN=$GET(PXBDXPRI):"P",1:"S")
- +14 IF $PIECE(REQI,U,7)
- SET $PIECE(POVAFT12,U,4)=$PIECE($GET(^AUPNVPRV($PIECE(REQI,U,7),0)),U,1)
- +15 IF POVBF812']""
- SET $PIECE(POVAF812,U,2,3)=$GET(PXBPKG)_U_$GET(PXBSOURC)
- +16 SET POVAF800=$GET(PXBREQ(IEN,"I"))
- if POVAF800=""
- SET POVAF800=$PIECE(ANS,U,4,20)
- +17 DO POV1
- +18 QUIT