- PXCACPT1 ;ISL/dee & LEA/Chylton - Validates & Translates data from the PCE Device Interface into PCE's PXK format for CPTs ;8/1/96
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**73,121,124**;Aug 12, 1996
- Q
- ; Variables
- ; PXCA Copy of PXCA array
- ; PXCAPROC Copy of a Procedure node of the PXCA array
- ; PXCAPRV Pointer to the provider (200)
- ; PXCANUMB Count of the number if CPTs and treatments
- ; PXCAINDX Count of the number of procedures for one provider
- ; PXCAFTER Temp used to build ^TMP(PXCAGLB,$J,"CPT",PXCANPRV,0,"AFTER")
- ; or to build ^TMP(PXCAGLB,$J,"TRT",PXCANPRV,0,"AFTER")
- ;
- CPT(PXCA,PXCAPROC,PXCANUMB,PXCAPRV,PXCAINDX,PXCAERRS) ;CPT
- N PXCAFTER,PXCACNT,PXCASTR,PXCAWARN,PXMDIEN
- S PXCAFTER=$P(PXCAPROC,"^",1)_"^"
- S PXCAFTER=PXCAFTER_PXCAPAT_"^"_PXCAVSIT_"^"
- S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",6)_"^"
- S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",5)_"^^" ;1ST Dx
- S PXCAFTER=PXCAFTER_$S($P(PXCAPROC,"^",3)="P":"Y",$P(PXCAPROC,"^",3)="S":"N",1:"")_"^^"
- S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",8)_"^" ;2nd Dx
- S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",9)_"^" ;3rd Dx
- S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",10)_"^" ;4th Dx
- S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",11)_"^" ;5th Dx
- S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",12)_"^" ;6th Dx
- S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",13)_"^" ;7th Dx
- S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",14)_"^" ;8th Dx
- S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",2)
- S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,"IEN")=""
- S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,0,"BEFORE")=""
- S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,0,"AFTER")=PXCAFTER
- IF $P(PXCAFTER,"^",5)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",5))
- IF $P(PXCAFTER,"^",9)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",9))
- IF $P(PXCAFTER,"^",10)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",10))
- IF $P(PXCAFTER,"^",11)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",11))
- IF $P(PXCAFTER,"^",12)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",12))
- IF $P(PXCAFTER,"^",13)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",13))
- IF $P(PXCAFTER,"^",14)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",14))
- IF $P(PXCAFTER,"^",15)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",15))
- ;Set modifier nodes
- S (PXCAMOD,PXCAWARN)=""
- F PXCACNT=1:1 S PXCAMOD=$O(PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)) Q:PXCAMOD="" D
- . S PXMDIEN=$$MODP^ICPTMOD(+PXCAFTER,PXCAMOD,"E",PXCADT)
- . I +PXMDIEN<1 D Q
- .. S PXCAWARN=$S(PXCAWARN="":"",1:PXCAWARN_",")_PXCAMOD
- .. S PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)="Invalid Modifier"
- . S PXCASTR=$$MOD^ICPTMOD(PXMDIEN,"I",PXCADT)
- . S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,1,PXCACNT,"BEFORE")=""
- . S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,1,PXCACNT,"AFTER")=+PXCASTR
- . I PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)="" D
- .. S PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)=$P(PXCASTR,"^",1,3)
- I PXCAWARN]"" D
- . S PXCA("WARNING","PROCEDURE",PXCAPRV,PXCAINDX,0)="CPT Modifier(s) "_PXCAWARN_" invalid. Code(s) not stored."
- S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,12,"BEFORE")=""
- S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,12,"AFTER")=$P(PXCAPROC,"^",4)_"^^^"_$S(PXCAPRV>0:PXCAPRV,1:"")
- S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,802,"BEFORE")=""
- S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,802,"AFTER")=$P(PXCAPROC,"^",7)
- S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,812,"BEFORE")=""
- S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCACPT1 3291 printed Feb 18, 2025@23:53:44 Page 2
- PXCACPT1 ;ISL/dee & LEA/Chylton - Validates & Translates data from the PCE Device Interface into PCE's PXK format for CPTs ;8/1/96
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**73,121,124**;Aug 12, 1996
- +2 QUIT
- +3 ; Variables
- +4 ; PXCA Copy of PXCA array
- +5 ; PXCAPROC Copy of a Procedure node of the PXCA array
- +6 ; PXCAPRV Pointer to the provider (200)
- +7 ; PXCANUMB Count of the number if CPTs and treatments
- +8 ; PXCAINDX Count of the number of procedures for one provider
- +9 ; PXCAFTER Temp used to build ^TMP(PXCAGLB,$J,"CPT",PXCANPRV,0,"AFTER")
- +10 ; or to build ^TMP(PXCAGLB,$J,"TRT",PXCANPRV,0,"AFTER")
- +11 ;
- CPT(PXCA,PXCAPROC,PXCANUMB,PXCAPRV,PXCAINDX,PXCAERRS) ;CPT
- +1 NEW PXCAFTER,PXCACNT,PXCASTR,PXCAWARN,PXMDIEN
- +2 SET PXCAFTER=$PIECE(PXCAPROC,"^",1)_"^"
- +3 SET PXCAFTER=PXCAFTER_PXCAPAT_"^"_PXCAVSIT_"^"
- +4 SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",6)_"^"
- +5 ;1ST Dx
- SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",5)_"^^"
- +6 SET PXCAFTER=PXCAFTER_$SELECT($PIECE(PXCAPROC,"^",3)="P":"Y",$PIECE(PXCAPROC,"^",3)="S":"N",1:"")_"^^"
- +7 ;2nd Dx
- SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",8)_"^"
- +8 ;3rd Dx
- SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",9)_"^"
- +9 ;4th Dx
- SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",10)_"^"
- +10 ;5th Dx
- SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",11)_"^"
- +11 ;6th Dx
- SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",12)_"^"
- +12 ;7th Dx
- SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",13)_"^"
- +13 ;8th Dx
- SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",14)_"^"
- +14 SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",2)
- +15 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,"IEN")=""
- +16 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,0,"BEFORE")=""
- +17 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,0,"AFTER")=PXCAFTER
- +18 IF $PIECE(PXCAFTER,"^",5)]""
- DO ANOTHPOV^PXCAPOV($PIECE(PXCAFTER,"^",5))
- +19 IF $PIECE(PXCAFTER,"^",9)]""
- DO ANOTHPOV^PXCAPOV($PIECE(PXCAFTER,"^",9))
- +20 IF $PIECE(PXCAFTER,"^",10)]""
- DO ANOTHPOV^PXCAPOV($PIECE(PXCAFTER,"^",10))
- +21 IF $PIECE(PXCAFTER,"^",11)]""
- DO ANOTHPOV^PXCAPOV($PIECE(PXCAFTER,"^",11))
- +22 IF $PIECE(PXCAFTER,"^",12)]""
- DO ANOTHPOV^PXCAPOV($PIECE(PXCAFTER,"^",12))
- +23 IF $PIECE(PXCAFTER,"^",13)]""
- DO ANOTHPOV^PXCAPOV($PIECE(PXCAFTER,"^",13))
- +24 IF $PIECE(PXCAFTER,"^",14)]""
- DO ANOTHPOV^PXCAPOV($PIECE(PXCAFTER,"^",14))
- +25 IF $PIECE(PXCAFTER,"^",15)]""
- DO ANOTHPOV^PXCAPOV($PIECE(PXCAFTER,"^",15))
- +26 ;Set modifier nodes
- +27 SET (PXCAMOD,PXCAWARN)=""
- +28 FOR PXCACNT=1:1
- SET PXCAMOD=$ORDER(PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD))
- if PXCAMOD=""
- QUIT
- Begin DoDot:1
- +29 SET PXMDIEN=$$MODP^ICPTMOD(+PXCAFTER,PXCAMOD,"E",PXCADT)
- +30 IF +PXMDIEN<1
- Begin DoDot:2
- +31 SET PXCAWARN=$SELECT(PXCAWARN="":"",1:PXCAWARN_",")_PXCAMOD
- +32 SET PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)="Invalid Modifier"
- End DoDot:2
- QUIT
- +33 SET PXCASTR=$$MOD^ICPTMOD(PXMDIEN,"I",PXCADT)
- +34 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,1,PXCACNT,"BEFORE")=""
- +35 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,1,PXCACNT,"AFTER")=+PXCASTR
- +36 IF PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)=""
- Begin DoDot:2
- +37 SET PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)=$PIECE(PXCASTR,"^",1,3)
- End DoDot:2
- End DoDot:1
- +38 IF PXCAWARN]""
- Begin DoDot:1
- +39 SET PXCA("WARNING","PROCEDURE",PXCAPRV,PXCAINDX,0)="CPT Modifier(s) "_PXCAWARN_" invalid. Code(s) not stored."
- End DoDot:1
- +40 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,12,"BEFORE")=""
- +41 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,12,"AFTER")=$PIECE(PXCAPROC,"^",4)_"^^^"_$SELECT(PXCAPRV>0:PXCAPRV,1:"")
- +42 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,802,"BEFORE")=""
- +43 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,802,"AFTER")=$PIECE(PXCAPROC,"^",7)
- +44 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,812,"BEFORE")=""
- +45 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
- +46 QUIT
- +47 ;