PXSCH4.m

PXSCH4 ;ISL/JVS - SCHEDULING REDESIGN PROCEDURES-DIAG #4 ;6/11/96

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

 ;  Variable List

 ;

 ; DXN800  "PXK" global data for various nodes

 ; DXN802       ""

 ; DXNOD0       ""

 ; DXNOD12      ""

 ; PXSDX     The Main Diagnosis

 ; PXSINDX   Index for "PXK" global

 ; PXSPR   The main provider

 ;

DIAG ;Create nodes for diagnosis

 Q:'$D(PXS("DIAGNOSIS"))

 S PXSDX=0 F  S PXSDX=$O(PXS("DIAGNOSIS",PXSDX)) Q:PXSDX=""  D

 .S PXSINDX=PXSINDX+1

 .D DXNOD

 Q

DXNOD ;

 S DXNOD0="",$P(DXNOD0,"^")=+$G(PXS("DIAGNOSIS",PXSDX))

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

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

 S PXSFILE=9000010.07

 K ^UTILITY("DIQ1",$J)

 S DIC=80,DA=PXSDX,DR=3 D EN^DIQ1

 S PXSZPN=$G(^UTILITY("DIQ1",$J,80,DA,3))

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

 S $P(DXNOD0,"^",4)=+$$PROVNARR^PXAPI(PXSZPN,PXSFILE)

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

 S DXNOD12=""

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

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

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

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

 ;S $P(DXNOD12,"^",7)=$P(DXNOD0,"^",3) ;SECONDARY VISIT

 S DXN800=""

 I $D(PXS("CLASSIFICATION",1)) S $P(DXN800,"^",2)=1

 I $D(PXS("CLASSIFICATION",2)) S $P(DXN800,"^",3)=1

 I $D(PXS("CLASSIFICATION",3)) S $P(DXN800,"^",1)=1

 I $D(PXS("CLASSIFICATION",4)) S $P(DXN800,"^",4)=1

 K ^UTILITY("DIQ1",$J)

 S DIC=80,DA=PXSDX,DR=5,DIQ(0)="E" D EN^DIQ1

 S PXSZPN=$G(^UTILITY("DIQ1",$J,80,DA,5,"E"))

 ;--DECIDED TO REMOVE CATEGORY

 ;K ^UTILITY("DIQ1",$J)

 ;S $P(DXN802,"^",1)=+$$PROVNARR^PXAPI(PXSZPN,PXSFILE)

 ;I $P(DXN802,"^",1)'>0 S $P(DXN802,"^",1)=""

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

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

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

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

 S ^TMP("PXK",$J,"POV",PXSINDX+1,800,"AFTER")=$G(DXN800)

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

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

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

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

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

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

DXDUP ;Look for duplicates on the same visit

 N XPFG,XP

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

 .I $P(^AUPNVPOV(XP,0),"^",1)=+$G(PXS("DIAGNOSIS",PXSDX)) D

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

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

 ..S ^TMP("PXK",$J,"POV",PXSINDX+1,800,"BEFORE")=$G(^AUPNVPOV(XP,800))

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

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

 ..S XPFG=1

 Q

PXSCH4    ;ISL/JVS - SCHEDULING REDESIGN PROCEDURES-DIAG #4 ;6/11/96

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

 +2       ;  Variable List

 +3       ;

 +4       ; DXN800  "PXK" global data for various nodes

 +5       ; DXN802       ""

 +6       ; DXNOD0       ""

 +7       ; DXNOD12      ""

 +8       ; PXSDX     The Main Diagnosis

 +9       ; PXSINDX   Index for "PXK" global

 +10      ; PXSPR   The main provider

 +11      ;

DIAG      ;Create nodes for diagnosis

 +1        IF '$DATA(PXS("DIAGNOSIS"))

               QUIT 

 +2        SET PXSDX=0

           FOR 

               SET PXSDX=$ORDER(PXS("DIAGNOSIS",PXSDX))

               IF PXSDX=""

                   QUIT 

               Begin DoDot:1

 +3                SET PXSINDX=PXSINDX+1

 +4                DO DXNOD

               End DoDot:1

 +5        QUIT 

DXNOD     ;

 +1        SET DXNOD0=""

           SET $PIECE(DXNOD0,"^")=+$GET(PXS("DIAGNOSIS",PXSDX))

 +2       ;PROVIDER

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

 +3       ;VISIT

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

 +4        SET PXSFILE=9000010.07

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

 +6        SET DIC=80

           SET DA=PXSDX

           SET DR=3

           DO EN^DIQ1

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

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

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

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

               QUIT 

 +11       SET DXNOD12=""

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

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

 +14      ;S $P(DXNOD12,"^",4)=$G(PXSPR) ;PROVIDER

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

 +16      ;S $P(DXNOD12,"^",7)=$P(DXNOD0,"^",3) ;SECONDARY VISIT

 +17       SET DXN800=""

 +18       IF $DATA(PXS("CLASSIFICATION",1))

               SET $PIECE(DXN800,"^",2)=1

 +19       IF $DATA(PXS("CLASSIFICATION",2))

               SET $PIECE(DXN800,"^",3)=1

 +20       IF $DATA(PXS("CLASSIFICATION",3))

               SET $PIECE(DXN800,"^",1)=1

 +21       IF $DATA(PXS("CLASSIFICATION",4))

               SET $PIECE(DXN800,"^",4)=1

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

 +23       SET DIC=80

           SET DA=PXSDX

           SET DR=5

           SET DIQ(0)="E"

           DO EN^DIQ1

 +24       SET PXSZPN=$GET(^UTILITY("DIQ1",$JOB,80,DA,5,"E"))

 +25      ;--DECIDED TO REMOVE CATEGORY

 +26      ;K ^UTILITY("DIQ1",$J)

 +27      ;S $P(DXN802,"^",1)=+$$PROVNARR^PXAPI(PXSZPN,PXSFILE)

 +28      ;I $P(DXN802,"^",1)'>0 S $P(DXN802,"^",1)=""

 +29       SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,0,"AFTER")=$GET(DXNOD0)

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

 +31       SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,12,"AFTER")=$GET(DXNOD12)

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

 +33       SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,800,"AFTER")=$GET(DXN800)

 +34       SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,800,"BEFORE")=""

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

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

 +37       SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,"IEN")=""

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

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

DXDUP     ;Look for duplicates on the same visit

 +1        NEW XPFG,XP

 +2        SET (XPFG,XP)=0

           FOR 

               IF XPFG

                   QUIT 

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

               IF XP=""

                   QUIT 

               Begin DoDot:1

 +3                IF $PIECE(^AUPNVPOV(XP,0),"^",1)=+$GET(PXS("DIAGNOSIS",PXSDX))

                       Begin DoDot:2

 +4                        SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,0,"BEFORE")=$GET(^AUPNVPOV(XP,0))

 +5                        SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,12,"BEFORE")=$GET(^AUPNVPOV(XP,12))

 +6                        SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,800,"BEFORE")=$GET(^AUPNVPOV(XP,800))

 +7                        SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,802,"BEFORE")=+$GET(^AUPNVPOV(XP,802))

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

 +9                        SET XPFG=1

                       End DoDot:2

               End DoDot:1

 +10       QUIT