| 1 | PXSCH2 ;ISL/JVS - SCHEDULING REDESIGN PROCEDURES-CPT #2 ;7/25/96 09:12
|
|---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**73**;Aug 12, 1996
|
|---|
| 3 | ; Variable List
|
|---|
| 4 | ;
|
|---|
| 5 | ; CPTNOD0 The data for the ^TMP("PXK",$J, globals
|
|---|
| 6 | ; CPTNOD12 The data for the ^TMP("PXK",$J, globals
|
|---|
| 7 | ; CPTNOD8 The data for the ^TMP("PXK",$J, globals
|
|---|
| 8 | ; PXSCPT Pointer to the precedure being processed
|
|---|
| 9 | ; PXSCPTQ Quantity of the above procedure
|
|---|
| 10 | ; PXSDX The main Diagnosis
|
|---|
| 11 | ; PXSINDX Index for the "PXK" global
|
|---|
| 12 | ; PXSPNN resolved provider narrative
|
|---|
| 13 | ; PXSPNN(1) "" "" ""
|
|---|
| 14 | ; PXSPR The main Provider
|
|---|
| 15 | ; XP,XPFG Scratch Variables
|
|---|
| 16 | ;
|
|---|
| 17 | SET ;Set the TMP("PXK",$J, GLOBAL
|
|---|
| 18 | CPT ;Create nodes for Procedures
|
|---|
| 19 | S PXSCPT=0 F S PXSCPT=$O(PXS("PROC",PXSCPT)) Q:PXSCPT="" D
|
|---|
| 20 | .S PXSINDX=PXSINDX+1
|
|---|
| 21 | .S PXSCPTQ=$G(PXS("PROC",PXSCPT))
|
|---|
| 22 | .D CPTNOD
|
|---|
| 23 | Q
|
|---|
| 24 | CPTNOD ;
|
|---|
| 25 | S CPTNOD0="",$P(CPTNOD0,"^")=$G(PXSCPT)
|
|---|
| 26 | S $P(CPTNOD0,"^",2)=$G(PXS("PATIENT")) ;PATIENT
|
|---|
| 27 | S $P(CPTNOD0,"^",3)=$G(PXS("VISIT")) ;VISIT
|
|---|
| 28 | S PXSFILE=9000010.18
|
|---|
| 29 | K ^UTILITY("DIQ1",$J)
|
|---|
| 30 | S DIC=81,DA=PXSCPT,DR=2 D EN^DIQ1
|
|---|
| 31 | S PXSZPN=$G(^UTILITY("DIQ1",$J,81,DA,2))
|
|---|
| 32 | K ^UTILITY("DIQ1",$J),DIC,DA,DR
|
|---|
| 33 | S $P(CPTNOD0,"^",4)=+$$PROVNARR^PXAPI(PXSZPN,PXSFILE) ;PROVIDER NARR
|
|---|
| 34 | Q:$P(CPTNOD0,"^",4)=-1
|
|---|
| 35 | ;S $P(CPTNOD0,"^",5)=$G(PXSDX) ;DIAGNOSIS
|
|---|
| 36 | S $P(CPTNOD0,"^",16)=$G(PXSCPTQ) ;QUANTITY
|
|---|
| 37 | S CPTNOD12=""
|
|---|
| 38 | ;S $P(CPTNOD12,"^")=$G(PXS("DATE")) ;DATE AND TIME
|
|---|
| 39 | ;S $P(CPTNOD12,"^",3)=$G(PXS("STOP CODE ORIG")) ;CLINIC STOP
|
|---|
| 40 | ;S $P(CPTNOD12,"^",4)=$G(PXSPR) ;PROVIDER
|
|---|
| 41 | ;S $P(CPTNOD12,"^",5)=$G(PXS("CLINIC")) ;HOSPITAL LOCATION
|
|---|
| 42 | ;S $P(CPTNOD12,"^",7)=$P(CPTNOD0,"^",3) ;SECONDARY VISIT
|
|---|
| 43 | ;--DECIDED TO REMOVE THE CATEGORY
|
|---|
| 44 | ;S CPTNOD8=""
|
|---|
| 45 | ;K ^UTILITY("DIQ1",$J) S DIC=81,DA=PXSCPT,DR=3,DIQ(0)="EIN" D EN^DIQ1
|
|---|
| 46 | ;I $G(^UTILITY("DIQ1",$J,81,DA,3,"I")) D
|
|---|
| 47 | ;.S PXSZPN=$G(^UTILITY("DIQ1",$J,81,DA,3,"E"))
|
|---|
| 48 | ;.S CPTNOD8=+$$PROVNARR^PXAPI(PXSZPN,PXSFILE)
|
|---|
| 49 | ;.I CPTNOD8'>0 S CPTNOD8=""
|
|---|
| 50 | ;K ^UTILITY("DIQ1",$J),DIC,DA,DR,DIQ
|
|---|
| 51 | S ^TMP("PXK",$J,"CPT",PXSINDX+1,0,"AFTER")=$G(CPTNOD0)
|
|---|
| 52 | S ^TMP("PXK",$J,"CPT",PXSINDX+1,0,"BEFORE")=""
|
|---|
| 53 | S ^TMP("PXK",$J,"CPT",PXSINDX+1,1,1,"BEFORE")=""
|
|---|
| 54 | S ^TMP("PXK",$J,"CPT",PXSINDX+1,12,"AFTER")=$G(CPTNOD12)
|
|---|
| 55 | S ^TMP("PXK",$J,"CPT",PXSINDX+1,12,"BEFORE")=""
|
|---|
| 56 | S ^TMP("PXK",$J,"CPT",PXSINDX+1,802,"AFTER")=""
|
|---|
| 57 | S ^TMP("PXK",$J,"CPT",PXSINDX+1,802,"BEFORE")=""
|
|---|
| 58 | S ^TMP("PXK",$J,"CPT",PXSINDX+1,"IEN")=""
|
|---|
| 59 | S ^TMP("PXK",$J,"SOR")=8
|
|---|
| 60 | S ^TMP("PXK",$J,"VST",1,"IEN")=$G(PXS("VISIT"))
|
|---|
| 61 | CPTDUP ;Look for duplicates on the same visit
|
|---|
| 62 | N XPFG,XP,PXKSEQ,PXKMOD
|
|---|
| 63 | S (XPFG,XP)=0
|
|---|
| 64 | F Q:XPFG S XP=$O(^AUPNVCPT("AD",PXS("VISIT"),XP)) Q:XP="" D
|
|---|
| 65 | .I $P(^AUPNVCPT(XP,0),"^",1)=PXSCPT D
|
|---|
| 66 | ..S ^TMP("PXK",$J,"CPT",PXSINDX+1,0,"BEFORE")=$G(^AUPNVCPT(XP,0))
|
|---|
| 67 | ..S PXKSEQ=0
|
|---|
| 68 | ..F S PXKSEQ=$O(^AUPNVCPT(XP,1,PXKSEQ)) Q:'PXKSEQ D
|
|---|
| 69 | ...S PXKMOD=^AUPNVCPT(XP,1,PXKSEQ,0)
|
|---|
| 70 | ...S ^TMP("PXK",$J,"CPT",PXSINDX+1,1,PXKSEQ,"BEFORE")=PXKMOD
|
|---|
| 71 | ..S ^TMP("PXK",$J,"CPT",PXSINDX+1,12,"BEFORE")=$G(^AUPNVCPT(XP,12))
|
|---|
| 72 | ..S ^TMP("PXK",$J,"CPT",PXSINDX+1,802,"BEFORE")=+$G(^AUPNVCPT(XP,802))
|
|---|
| 73 | ..S ^TMP("PXK",$J,"CPT",PXSINDX+1,"IEN")=XP
|
|---|
| 74 | ..S XPFG=1
|
|---|
| 75 | Q
|
|---|
