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

PXSCH1.m

Go to the documentation of this file.
  1. PXSCH1 ;ISL/JVS - SCHEDULING REDESIGN PROCEDURES ;6/11/96
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
  1. ; Variable List
  1. ;
  1. ; PXS(***) The various pieces of data to move
  1. ; PXS1..PXSn Scratch Variables
  1. ; PXSCNT Counter- Number of a particular procedure
  1. ; PXSCS0 ^TMP("SCCVEVT",$J,"CS",0) node
  1. ; PXSCSI0 ^TMP("SCCVEVT",$J,"CS",xx,0) node
  1. ; PXSCISPR ^TMP("SCCVEVT",$J,"CS",xx,"PR") node
  1. ; PXSOE ^TMP("SCCVEVT",$J,"SDOE",xx,0) node
  1. ; PXSDOE IEN on the $O(^TMP("SCCVEVT",$J,"SDOE",0) node
  1. ; PXSDVI IEN on the $O(^TMP("SCCVEVT",$J,"CS",0) node
  1. ; PXSDX Pointer to the Diagnosis
  1. ; PXSIEN Scratch Variable for $Ordering
  1. ; PXSINDX increment subscripts in ^TMP("PXK" global
  1. ; PXSPR Pointer to the main Provider
  1. ;
  1. ;
  1. EN1 ;Entry point
  1. N PXS1,PXS2,PXS3,PXS4,PXSCNT,PXSCS0,PXSCSI0,PXSCSIPR,PXSDOE,PXSDVI
  1. N PXSDX,PXSIEN,PXSINDX,PXSOE,PXSPR,CPTNOD0,CPTNOD12,CPTNOD8
  1. N PXSCPT,PXSCPTQ,PXSDX,PXSINDX,PXSPNN,PXSPNNN,PXSPR,PRVNOD0,PRVNOD12
  1. N PXSCT,PXSPRV,DXN800,DXN802,DXNOD0,DXNOD12
  1. N PXSZPN,PXSFILE
  1. ;
  1. CHECK ;Check on variables and/or environment
  1. S PXS1=12 Q:$G(PXS1)'[SCCVEVT
  1. Q:$G(SCCVORG)'=2
  1. SET ;Set up needed variables
  1. S PXSDVI=$O(^TMP("SCCVEVT",$J,"CS",0))
  1. S PXSDOE=$O(^TMP("SCCVEVT",$J,"SDOE",0))
  1. LOCLIZE ; Set the tmp global into local array for speed
  1. S PXSCS0=$G(^TMP("SCCVEVT",$J,"CS",0))
  1. S PXSCSI0=$G(^TMP("SCCVEVT",$J,"CS",PXSDVI,0))
  1. S PXSCSIPR=$G(^TMP("SCCVEVT",$J,"CS",PXSDVI,"PR"))
  1. S PXSOE=$G(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,0))
  1. ARRAY ;Set all of the data into variables
  1. S PXS("DATE")=$P(PXSCS0,"^")
  1. S PXS("PATIENT")=$P(PXSCS0,"^",2)
  1. S PXS("DIVISION")=$P(PXSCS0,"^",3)
  1. S PXS("STOP CODE")=$P(PXSCSI0,"^")
  1. S PXS("CLINIC")=$P(PXSCSI0,"^",3)
  1. S PXS("ELIGIBILITY")=$P(PXSCSI0,"^",4)
  1. S PXS("OUT PAT ENCOU")=PXSDOE
  1. S PXS("PROCEDURE",1)=$P(PXSCSIPR,"^",1)
  1. S PXS("PROCEDURE",2)=$P(PXSCSIPR,"^",2)
  1. S PXS("PROCEDURE",3)=$P(PXSCSIPR,"^",3)
  1. S PXS("PROCEDURE",4)=$P(PXSCSIPR,"^",4)
  1. S PXS("PROCEDURE",5)=$P(PXSCSIPR,"^",5)
  1. S PXS("STOP CODE ORIG")=$P(PXSOE,"^",3)
  1. S PXS("VISIT")=$P(PXSOE,"^",5)
  1. Q:$G(PXS("VISIT"))'>0
  1. S PXS("PARENT ENCOUNTER")=$P(PXSOE,"^",6)
  1. ;
  1. DX ;Set Diagnosis array
  1. I $D(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"DX")) D
  1. .S PXSIEN=0 F S PXSIEN=$O(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"DX",PXSIEN)) Q:PXSIEN="" D
  1. ..S PXS("DIAGNOSIS",PXSIEN)=$G(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"DX",PXSIEN,0))
  1. ;
  1. DOC ;Set Provider array
  1. I $D(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"PR")) D
  1. .S PXSIEN=0 F S PXSIEN=$O(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"PR",PXSIEN)) Q:PXSIEN="" D
  1. ..S PXS("PROVIDER",PXSIEN)=$G(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"PR",PXSIEN,0))
  1. CLASS ;Set Classification array
  1. I $D(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"CL")) D
  1. .S PXSIEN=0 F S PXSIEN=$O(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"CL",PXSIEN)) Q:PXSIEN="" D
  1. ..S PXS("CLASSIFICATION",$P($G(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"CL",PXSIEN,0)),"^",1))=""
  1. ;
  1. COUNT ;Count up the total number of procedures
  1. N PXS1,PXS2,PXS3,PXS4,PXSCNT
  1. S (PXS1,PXS2,PXS3,PXS4)=0,PXSCNT=0
  1. F S PXS1=$O(PXS("PROCEDURE",PXS1)) Q:PXS1="" D
  1. .S PXS4=$G(PXS("PROCEDURE",PXS1))
  1. .S PXS2="" F S PXS2=$O(PXS("PROCEDURE",PXS2)) Q:PXS2="" D
  1. ..I $G(PXS("PROCEDURE",PXS2))=PXS4 S PXSCNT=PXSCNT+1
  1. .I PXS4'="" S PXS("PROC",PXS4)=PXSCNT S PXSCNT=0
  1. ;
  1. I $D(PXS("DIAGNOSIS")) S PXSDX=+$G(PXS("DIAGNOSIS",$O(PXS("DIAGNOSIS",0))))
  1. I $D(PXS("PROVIDER")) S PXSPR=+$G(PXS("PROVIDER",$O(PXS("PROVIDER",0))))
  1. S PXSINDX=0
  1. D CPT^PXSCH2,PRV^PXSCH3,DIAG^PXSCH4
  1. D EN1^PXKMAIN
  1. EXIT ;
  1. K PXS,PXSPNN,PXSPNNN,PXKCO
  1. K ^TMP("PXK",$J)
  1. K %DD,%DT,%W,%Y,D,D0,DI,DIC,DQ,X,S,DX
  1. Q