Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXSCH4

PXSCH4.m

Go to the documentation of this file.
  1. PXSCH4 ;ISL/JVS,SCK - SCHEDULING REDESIGN PROCEDURES-DIAG #4 ;6/11/96
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**194,199**;Aug 12, 1996;Build 51
  1. ; Variable List
  1. ;
  1. ; DXN800 "PXK" global data for various nodes
  1. ; DXN802 ""
  1. ; DXNOD0 ""
  1. ; DXNOD12 ""
  1. ; PXSDX The Main Diagnosis
  1. ; PXSINDX Index for "PXK" global
  1. ; PXSPR The main provider
  1. ;
  1. DIAG ;Create nodes for diagnosis
  1. Q:'$D(PXS("DIAGNOSIS"))
  1. S PXSDX=0 F S PXSDX=$O(PXS("DIAGNOSIS",PXSDX)) Q:PXSDX="" D
  1. .S PXSINDX=PXSINDX+1
  1. .D DXNOD
  1. Q
  1. DXNOD ;
  1. S DXNOD0="",$P(DXNOD0,"^")=+$G(PXS("DIAGNOSIS",PXSDX))
  1. S $P(DXNOD0,"^",2)=$G(PXS("PATIENT")) ;PROVIDER
  1. S $P(DXNOD0,"^",3)=$G(PXS("VISIT")) ;VISIT
  1. N ICDDATA,PXSDATE
  1. S PXSDATE=$$CSDATE^PXDXUTL($G(PXS("VISIT")))
  1. S PXSFILE=9000010.07
  1. S ICDDATA=$$ICDDATA^ICDXCODE("DIAG",PXSDX,PXSDATE,"E")
  1. S PXSZPN=$P(ICDDATA,U,4)
  1. S $P(DXNOD0,"^",4)=+$$PROVNARR^PXAPI(PXSZPN,PXSFILE)
  1. Q:$P(DXNOD0,"^",4)=-1
  1. S DXNOD12=""
  1. ;S $P(DXNOD12,"^")=$G(PXS("DATE")) ;DATE AND TIME
  1. ;S $P(DXNOD12,"^",3)=$G(PXS("STOP CODE ORIG")) ;CLINIC STOP
  1. ;S $P(DXNOD12,"^",4)=$G(PXSPR) ;PROVIDER
  1. ;S $P(DXNOD12,"^",5)=$G(PXS("CLINIC")) ;HOSPITAL LOCATION
  1. ;S $P(DXNOD12,"^",7)=$P(DXNOD0,"^",3) ;SECONDARY VISIT
  1. S DXN800=""
  1. I $D(PXS("CLASSIFICATION",1)) S $P(DXN800,"^",2)=1
  1. I $D(PXS("CLASSIFICATION",2)) S $P(DXN800,"^",3)=1
  1. I $D(PXS("CLASSIFICATION",3)) S $P(DXN800,"^",1)=1
  1. I $D(PXS("CLASSIFICATION",4)) S $P(DXN800,"^",4)=1
  1. N PXS1
  1. S PXS1=$P(ICDDATA,U,6)
  1. S PXSZPN=$$GET1^DIQ(80.3,PXS1,.01)
  1. ;--DECIDED TO REMOVE CATEGORY
  1. ;K ^UTILITY("DIQ1",$J)
  1. ;S $P(DXN802,"^",1)=+$$PROVNARR^PXAPI(PXSZPN,PXSFILE)
  1. ;I $P(DXN802,"^",1)'>0 S $P(DXN802,"^",1)=""
  1. S ^TMP("PXK",$J,"POV",PXSINDX+1,0,"AFTER")=$G(DXNOD0)
  1. S ^TMP("PXK",$J,"POV",PXSINDX+1,0,"BEFORE")=""
  1. S ^TMP("PXK",$J,"POV",PXSINDX+1,12,"AFTER")=$G(DXNOD12)
  1. S ^TMP("PXK",$J,"POV",PXSINDX+1,12,"BEFORE")=""
  1. S ^TMP("PXK",$J,"POV",PXSINDX+1,800,"AFTER")=$G(DXN800)
  1. S ^TMP("PXK",$J,"POV",PXSINDX+1,800,"BEFORE")=""
  1. S ^TMP("PXK",$J,"POV",PXSINDX+1,802,"AFTER")=""
  1. S ^TMP("PXK",$J,"POV",PXSINDX+1,802,"BEFORE")=""
  1. S ^TMP("PXK",$J,"POV",PXSINDX+1,"IEN")=""
  1. S ^TMP("PXK",$J,"SOR")=8
  1. S ^TMP("PXK",$J,"VST",1,"IEN")=$G(PXS("VISIT"))
  1. DXDUP ;Look for duplicates on the same visit
  1. N XPFG,XP
  1. S (XPFG,XP)=0
  1. F Q:XPFG S XP=$O(^AUPNVPOV("AD",PXS("VISIT"),XP)) Q:XP="" D
  1. .I $P(^AUPNVPOV(XP,0),"^",1)=+$G(PXS("DIAGNOSIS",PXSDX)) D
  1. ..S ^TMP("PXK",$J,"POV",PXSINDX+1,0,"BEFORE")=$G(^AUPNVPOV(XP,0))
  1. ..S ^TMP("PXK",$J,"POV",PXSINDX+1,12,"BEFORE")=$G(^AUPNVPOV(XP,12))
  1. ..S ^TMP("PXK",$J,"POV",PXSINDX+1,800,"BEFORE")=$G(^AUPNVPOV(XP,800))
  1. ..S ^TMP("PXK",$J,"POV",PXSINDX+1,802,"BEFORE")=+$G(^AUPNVPOV(XP,802))
  1. ..S ^TMP("PXK",$J,"POV",PXSINDX+1,"IEN")=XP
  1. ..S XPFG=1
  1. Q