PXSCH3.m

PXSCH3 ;ISL/JVS - SCHEDULING REDESIGN PROCEDURES-PRV #3 ;6/11/96

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

 ;  Variable List

 ;

 ; PRVNOD0   Provider node data

 ; PRVNOD12  Providr node dat

 ; PXSCT     Counter provider to set Promary/Secondary

 ; PXSINDX   Index for ^tmp("PXK" global

 ; PXSPR     The main Provider

 ; PXSPRV    The Provider being Processed

 ;

PRV ;Create nodes for Providers

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

 S PXSCT=0

 S PXSPRV=0 F  S PXSPRV=$O(PXS("PROVIDER",PXSPRV)) Q:PXSPRV=""  D

 .S PXSINDX=PXSINDX+1

 .S PXSCT=PXSCT+1

 .D PRVNOD

 Q

PRVNOD ;

 S PRVNOD0="",$P(PRVNOD0,"^")=+$G(PXS("PROVIDER",PXSPRV))

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

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

 S $P(PRVNOD0,"^",4)=$S(PXSCT=1:"P",PXSCT>1:"S",1:"") ;PRIMARY/SECONDARY

 S PRVNOD12=""

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

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

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

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

 ;S $P(PRVNOD12,"^",7)=$P(PRVNOD0,"^",3) ;SECONDARY VISIT

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

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

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

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

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

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

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

PRVDUP ;Look for duplicates on the same visit

 N XPFG,XP

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

 .I $P(^AUPNVPRV(XP,0),"^",1)=+$G(PXS("PROVIDER",PXSPRV)) D

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

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

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

 ..S XPFG=1

 Q

PXSCH3    ;ISL/JVS - SCHEDULING REDESIGN PROCEDURES-PRV #3 ;6/11/96

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

 +2       ;  Variable List

 +3       ;

 +4       ; PRVNOD0   Provider node data

 +5       ; PRVNOD12  Providr node dat

 +6       ; PXSCT     Counter provider to set Promary/Secondary

 +7       ; PXSINDX   Index for ^tmp("PXK" global

 +8       ; PXSPR     The main Provider

 +9       ; PXSPRV    The Provider being Processed

 +10      ;

PRV       ;Create nodes for Providers

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

               QUIT 

 +2        SET PXSCT=0

 +3        SET PXSPRV=0

           FOR 

               SET PXSPRV=$ORDER(PXS("PROVIDER",PXSPRV))

               IF PXSPRV=""

                   QUIT 

               Begin DoDot:1

 +4                SET PXSINDX=PXSINDX+1

 +5                SET PXSCT=PXSCT+1

 +6                DO PRVNOD

               End DoDot:1

 +7        QUIT 

PRVNOD    ;

 +1        SET PRVNOD0=""

           SET $PIECE(PRVNOD0,"^")=+$GET(PXS("PROVIDER",PXSPRV))

 +2       ;PROVIDER

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

 +3       ;VISIT

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

 +4       ;PRIMARY/SECONDARY

           SET $PIECE(PRVNOD0,"^",4)=$SELECT(PXSCT=1:"P",PXSCT>1:"S",1:"")

 +5        SET PRVNOD12=""

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

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

 +8       ;S $P(PRVNOD12,"^",4)=$G(PXSPR) ;PROVIDER

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

 +10      ;S $P(PRVNOD12,"^",7)=$P(PRVNOD0,"^",3) ;SECONDARY VISIT

 +11       SET ^TMP("PXK",$JOB,"PRV",PXSINDX+1,0,"AFTER")=$GET(PRVNOD0)

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

 +13       SET ^TMP("PXK",$JOB,"PRV",PXSINDX+1,12,"AFTER")=$GET(PRVNOD12)

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

 +15       SET ^TMP("PXK",$JOB,"PRV",PXSINDX+1,"IEN")=""

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

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

PRVDUP    ;Look for duplicates on the same visit

 +1        NEW XPFG,XP

 +2        SET (XPFG,XP)=0

           FOR 

               IF XPFG

                   QUIT 

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

               IF XP=""

                   QUIT 

               Begin DoDot:1

 +3                IF $PIECE(^AUPNVPRV(XP,0),"^",1)=+$GET(PXS("PROVIDER",PXSPRV))

                       Begin DoDot:2

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

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

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

 +7                        SET XPFG=1

                       End DoDot:2

               End DoDot:1

 +8        QUIT