PXSCH2.m

PXSCH2 ;ISL/JVS - SCHEDULING REDESIGN PROCEDURES-CPT #2 ;7/25/96  09:12

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**73**;Aug 12, 1996

 ;  Variable List

 ;

 ; CPTNOD0   The data for the ^TMP("PXK",$J,  globals

 ; CPTNOD12  The data for the ^TMP("PXK",$J,  globals

 ; CPTNOD8   The data for the ^TMP("PXK",$J,  globals

 ; PXSCPT    Pointer to the precedure being processed

 ; PXSCPTQ   Quantity of the above procedure

 ; PXSDX     The main Diagnosis

 ; PXSINDX   Index for the "PXK" global

 ; PXSPNN    resolved provider narrative

 ; PXSPNN(1)    ""       ""      ""

 ; PXSPR     The main Provider

 ; XP,XPFG   Scratch Variables

 ;

SET ;Set the TMP("PXK",$J, GLOBAL

CPT ;Create nodes for Procedures

 S PXSCPT=0 F  S PXSCPT=$O(PXS("PROC",PXSCPT)) Q:PXSCPT=""  D

 .S PXSINDX=PXSINDX+1

 .S PXSCPTQ=$G(PXS("PROC",PXSCPT))

 .D CPTNOD

 Q

CPTNOD ;

 S CPTNOD0="",$P(CPTNOD0,"^")=$G(PXSCPT)

 S $P(CPTNOD0,"^",2)=$G(PXS("PATIENT")) ;PATIENT

 S $P(CPTNOD0,"^",3)=$G(PXS("VISIT")) ;VISIT

 S PXSFILE=9000010.18

 K ^UTILITY("DIQ1",$J)

 S DIC=81,DA=PXSCPT,DR=2 D EN^DIQ1

 S PXSZPN=$G(^UTILITY("DIQ1",$J,81,DA,2))

 K ^UTILITY("DIQ1",$J),DIC,DA,DR

 S $P(CPTNOD0,"^",4)=+$$PROVNARR^PXAPI(PXSZPN,PXSFILE) ;PROVIDER NARR

 Q:$P(CPTNOD0,"^",4)=-1

 ;S $P(CPTNOD0,"^",5)=$G(PXSDX) ;DIAGNOSIS

 S $P(CPTNOD0,"^",16)=$G(PXSCPTQ) ;QUANTITY

 S CPTNOD12=""

 ;S $P(CPTNOD12,"^")=$G(PXS("DATE")) ;DATE AND TIME

 ;S $P(CPTNOD12,"^",3)=$G(PXS("STOP CODE ORIG")) ;CLINIC STOP

 ;S $P(CPTNOD12,"^",4)=$G(PXSPR) ;PROVIDER

 ;S $P(CPTNOD12,"^",5)=$G(PXS("CLINIC")) ;HOSPITAL LOCATION

 ;S $P(CPTNOD12,"^",7)=$P(CPTNOD0,"^",3) ;SECONDARY VISIT

 ;--DECIDED TO REMOVE THE CATEGORY

 ;S CPTNOD8=""

 ;K ^UTILITY("DIQ1",$J) S DIC=81,DA=PXSCPT,DR=3,DIQ(0)="EIN" D EN^DIQ1

 ;I $G(^UTILITY("DIQ1",$J,81,DA,3,"I")) D

 ;.S PXSZPN=$G(^UTILITY("DIQ1",$J,81,DA,3,"E"))

 ;.S CPTNOD8=+$$PROVNARR^PXAPI(PXSZPN,PXSFILE)

 ;.I CPTNOD8'>0 S CPTNOD8=""

 ;K ^UTILITY("DIQ1",$J),DIC,DA,DR,DIQ

 S ^TMP("PXK",$J,"CPT",PXSINDX+1,0,"AFTER")=$G(CPTNOD0)

 S ^TMP("PXK",$J,"CPT",PXSINDX+1,0,"BEFORE")=""

 S ^TMP("PXK",$J,"CPT",PXSINDX+1,1,1,"BEFORE")=""

 S ^TMP("PXK",$J,"CPT",PXSINDX+1,12,"AFTER")=$G(CPTNOD12)

 S ^TMP("PXK",$J,"CPT",PXSINDX+1,12,"BEFORE")=""

 S ^TMP("PXK",$J,"CPT",PXSINDX+1,802,"AFTER")=""

 S ^TMP("PXK",$J,"CPT",PXSINDX+1,802,"BEFORE")=""

 S ^TMP("PXK",$J,"CPT",PXSINDX+1,"IEN")=""

 S ^TMP("PXK",$J,"SOR")=8

 S ^TMP("PXK",$J,"VST",1,"IEN")=$G(PXS("VISIT"))

CPTDUP ;Look for duplicates on the same visit

 N XPFG,XP,PXKSEQ,PXKMOD

 S (XPFG,XP)=0

 F  Q:XPFG  S XP=$O(^AUPNVCPT("AD",PXS("VISIT"),XP)) Q:XP=""  D

 .I $P(^AUPNVCPT(XP,0),"^",1)=PXSCPT D

 ..S ^TMP("PXK",$J,"CPT",PXSINDX+1,0,"BEFORE")=$G(^AUPNVCPT(XP,0))

 ..S PXKSEQ=0

 ..F  S PXKSEQ=$O(^AUPNVCPT(XP,1,PXKSEQ)) Q:'PXKSEQ  D

 ...S PXKMOD=^AUPNVCPT(XP,1,PXKSEQ,0)

 ...S ^TMP("PXK",$J,"CPT",PXSINDX+1,1,PXKSEQ,"BEFORE")=PXKMOD

 ..S ^TMP("PXK",$J,"CPT",PXSINDX+1,12,"BEFORE")=$G(^AUPNVCPT(XP,12))

 ..S ^TMP("PXK",$J,"CPT",PXSINDX+1,802,"BEFORE")=+$G(^AUPNVCPT(XP,802))

 ..S ^TMP("PXK",$J,"CPT",PXSINDX+1,"IEN")=XP

 ..S XPFG=1

 Q

PXSCH2    ;ISL/JVS - SCHEDULING REDESIGN PROCEDURES-CPT #2 ;7/25/96  09:12

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**73**;Aug 12, 1996

 +2       ;  Variable List

 +3       ;

 +4       ; CPTNOD0   The data for the ^TMP("PXK",$J,  globals

 +5       ; CPTNOD12  The data for the ^TMP("PXK",$J,  globals

 +6       ; CPTNOD8   The data for the ^TMP("PXK",$J,  globals

 +7       ; PXSCPT    Pointer to the precedure being processed

 +8       ; PXSCPTQ   Quantity of the above procedure

 +9       ; PXSDX     The main Diagnosis

 +10      ; PXSINDX   Index for the "PXK" global

 +11      ; PXSPNN    resolved provider narrative

 +12      ; PXSPNN(1)    ""       ""      ""

 +13      ; PXSPR     The main Provider

 +14      ; XP,XPFG   Scratch Variables

 +15      ;

SET       ;Set the TMP("PXK",$J, GLOBAL

CPT       ;Create nodes for Procedures

 +1        SET PXSCPT=0

           FOR 

               SET PXSCPT=$ORDER(PXS("PROC",PXSCPT))

               IF PXSCPT=""

                   QUIT 

               Begin DoDot:1

 +2                SET PXSINDX=PXSINDX+1

 +3                SET PXSCPTQ=$GET(PXS("PROC",PXSCPT))

 +4                DO CPTNOD

               End DoDot:1

 +5        QUIT 

CPTNOD    ;

 +1        SET CPTNOD0=""

           SET $PIECE(CPTNOD0,"^")=$GET(PXSCPT)

 +2       ;PATIENT

           SET $PIECE(CPTNOD0,"^",2)=$GET(PXS("PATIENT"))

 +3       ;VISIT

           SET $PIECE(CPTNOD0,"^",3)=$GET(PXS("VISIT"))

 +4        SET PXSFILE=9000010.18

 +5        KILL ^UTILITY("DIQ1",$JOB)

 +6        SET DIC=81

           SET DA=PXSCPT

           SET DR=2

           DO EN^DIQ1

 +7        SET PXSZPN=$GET(^UTILITY("DIQ1",$JOB,81,DA,2))

 +8        KILL ^UTILITY("DIQ1",$JOB),DIC,DA,DR

 +9       ;PROVIDER NARR

           SET $PIECE(CPTNOD0,"^",4)=+$$PROVNARR^PXAPI(PXSZPN,PXSFILE)

 +10       IF $PIECE(CPTNOD0,"^",4)=-1

               QUIT 

 +11      ;S $P(CPTNOD0,"^",5)=$G(PXSDX) ;DIAGNOSIS

 +12      ;QUANTITY

           SET $PIECE(CPTNOD0,"^",16)=$GET(PXSCPTQ)

 +13       SET CPTNOD12=""

 +14      ;S $P(CPTNOD12,"^")=$G(PXS("DATE")) ;DATE AND TIME

 +15      ;S $P(CPTNOD12,"^",3)=$G(PXS("STOP CODE ORIG")) ;CLINIC STOP

 +16      ;S $P(CPTNOD12,"^",4)=$G(PXSPR) ;PROVIDER

 +17      ;S $P(CPTNOD12,"^",5)=$G(PXS("CLINIC")) ;HOSPITAL LOCATION

 +18      ;S $P(CPTNOD12,"^",7)=$P(CPTNOD0,"^",3) ;SECONDARY VISIT

 +19      ;--DECIDED TO REMOVE THE CATEGORY

 +20      ;S CPTNOD8=""

 +21      ;K ^UTILITY("DIQ1",$J) S DIC=81,DA=PXSCPT,DR=3,DIQ(0)="EIN" D EN^DIQ1

 +22      ;I $G(^UTILITY("DIQ1",$J,81,DA,3,"I")) D

 +23      ;.S PXSZPN=$G(^UTILITY("DIQ1",$J,81,DA,3,"E"))

 +24      ;.S CPTNOD8=+$$PROVNARR^PXAPI(PXSZPN,PXSFILE)

 +25      ;.I CPTNOD8'>0 S CPTNOD8=""

 +26      ;K ^UTILITY("DIQ1",$J),DIC,DA,DR,DIQ

 +27       SET ^TMP("PXK",$JOB,"CPT",PXSINDX+1,0,"AFTER")=$GET(CPTNOD0)

 +28       SET ^TMP("PXK",$JOB,"CPT",PXSINDX+1,0,"BEFORE")=""

 +29       SET ^TMP("PXK",$JOB,"CPT",PXSINDX+1,1,1,"BEFORE")=""

 +30       SET ^TMP("PXK",$JOB,"CPT",PXSINDX+1,12,"AFTER")=$GET(CPTNOD12)

 +31       SET ^TMP("PXK",$JOB,"CPT",PXSINDX+1,12,"BEFORE")=""

 +32       SET ^TMP("PXK",$JOB,"CPT",PXSINDX+1,802,"AFTER")=""

 +33       SET ^TMP("PXK",$JOB,"CPT",PXSINDX+1,802,"BEFORE")=""

 +34       SET ^TMP("PXK",$JOB,"CPT",PXSINDX+1,"IEN")=""

 +35       SET ^TMP("PXK",$JOB,"SOR")=8

 +36       SET ^TMP("PXK",$JOB,"VST",1,"IEN")=$GET(PXS("VISIT"))

CPTDUP    ;Look for duplicates on the same visit

 +1        NEW XPFG,XP,PXKSEQ,PXKMOD

 +2        SET (XPFG,XP)=0

 +3        FOR 

               IF XPFG

                   QUIT 

               SET XP=$ORDER(^AUPNVCPT("AD",PXS("VISIT"),XP))

               IF XP=""

                   QUIT 

               Begin DoDot:1

 +4                IF $PIECE(^AUPNVCPT(XP,0),"^",1)=PXSCPT

                       Begin DoDot:2

 +5                        SET ^TMP("PXK",$JOB,"CPT",PXSINDX+1,0,"BEFORE")=$GET(^AUPNVCPT(XP,0))

 +6                        SET PXKSEQ=0

 +7                        FOR 

                               SET PXKSEQ=$ORDER(^AUPNVCPT(XP,1,PXKSEQ))

                               IF 'PXKSEQ

                                   QUIT 

                               Begin DoDot:3

 +8                                SET PXKMOD=^AUPNVCPT(XP,1,PXKSEQ,0)

 +9                                SET ^TMP("PXK",$JOB,"CPT",PXSINDX+1,1,PXKSEQ,"BEFORE")=PXKMOD

                               End DoDot:3

 +10                       SET ^TMP("PXK",$JOB,"CPT",PXSINDX+1,12,"BEFORE")=$GET(^AUPNVCPT(XP,12))

 +11                       SET ^TMP("PXK",$JOB,"CPT",PXSINDX+1,802,"BEFORE")=+$GET(^AUPNVCPT(XP,802))

 +12                       SET ^TMP("PXK",$JOB,"CPT",PXSINDX+1,"IEN")=XP

 +13                       SET XPFG=1

                       End DoDot:2

               End DoDot:1

 +14       QUIT