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

AZAXCADU.m

Go to the documentation of this file.
  1. AZAXCADU ;IHS/PHXAO/AEF - CAD/STATIN STUDY DATA EXTRACT UTILITY SUBROUTINES
  1. ;;1.0;ANNE'S SPECIAL ROUTINES;;MAR 23, 2004
  1. ;
  1. DESC ;---- PROGRAM DESCRIPTION
  1. ;;
  1. ;; This routine contains utility subroutines used by the
  1. ;; AZAXCAD CAD/STATIN STUDY DATA EXTRACT routine.
  1. ;;
  1. ;;$$END
  1. ;
  1. Q
  1. ;
  1. AGE(X) ;
  1. ;----- RETURN PATIENT'S AGE
  1. ;
  1. ; X = PATIENT IEN
  1. ;
  1. N X1,X2,Y
  1. S Y=""
  1. I $G(X) D
  1. . S X2=$P($G(^DPT(X,0)),U,3)
  1. . I X2 D
  1. . . S X1=DT
  1. . . D ^%DTC
  1. . . S Y=X\365.25
  1. Q Y
  1. ;
  1. DRUG(X) ;
  1. ;----- RETURN DRUG NAME
  1. ;
  1. ; X = DRUG IEN
  1. ;
  1. N Y
  1. S Y=""
  1. I $G(X) S Y=$P($G(^PSDRUG(X,0)),U)
  1. Q Y
  1. ;
  1. FNAME(X) ;
  1. ;----- RETURN FILE NAME
  1. ;
  1. ; X = DATA TYPE, I.E., DRUGS OR ICDS
  1. ;
  1. N Y
  1. S Y=""
  1. I $G(X)]"" D
  1. . S Y="AZAX"_X_$$SITE_".TXT"
  1. Q Y
  1. FORMAT(X) ;
  1. ;----- FORMAT "^" DELIMITED DATA STRING INTO COMMA DELIMITED STRING
  1. ;
  1. ; INPUT:
  1. ; X = DATA STRING IN "^" DELIMITED FIELD FORMAT,
  1. ; I.E., FIELD1^FIELD2^FIELD3^FIELD4
  1. ;
  1. ; OUTPUT:
  1. ; Y = DATA STRING IN QUOTED DATA/COMMA DELIMITED FORMAT,
  1. ; I.E., "FIELD1","FIELD2","FIELD3","FIELD4"
  1. ;
  1. N I,Y,Z
  1. S Y=""
  1. I $G(X)]"" D
  1. . F I=1:1:$L(X,U) D
  1. . . S Z=$P(X,U,I)
  1. . . S Y=Y_""""_Z_""""_","
  1. . S Y=$E(Y,1,$L(Y)-1)
  1. Q Y
  1. ;
  1. HFS(AZAXPATH,AZAXFILE,%FILE,AZAXOUT) ;
  1. ;----- CREATE AND OPEN DATA FILE
  1. ;
  1. ; INPUT:
  1. ; AZAXFILE = THE FILENAME TO CREATE AND OPEN
  1. ; AZAXPATH = THE UNIX OR WINDOWS DIRECTORY PATH NAME TO PUT THE FILE
  1. ;
  1. ; OUTPUT:
  1. ; %FILE = DEVICE NUMBER OF THE FILE
  1. ; AZAXOUT = QUIT INDICATOR
  1. ;
  1. N POP,X,Y,ZISH1,ZISH2,ZISH3,ZISH4
  1. ;
  1. S %FILE=""
  1. S AZAXOUT=0
  1. S ZISH1="FILE"
  1. S ZISH2=AZAXPATH
  1. S ZISH3=AZAXFILE
  1. S ZISH4="W"
  1. ;
  1. D OPEN^%ZISH(ZISH1,ZISH2,ZISH3,ZISH4)
  1. ;
  1. I POP D Q
  1. . W "CANNOT OPEN FILE "_ZISH2_ZISH3
  1. . S AZAXOUT=1
  1. S %FILE=IO
  1. Q
  1. ICD(X) ;
  1. ;----- RESOLVE ICD DX CODE POINTER
  1. ;
  1. ; X = INTERNAL ICD DIAGNOSIS CODE
  1. ;
  1. N Y
  1. S Y=""
  1. I $G(X) S Y=$P($G(^ICD9(X,0)),U)
  1. Q Y
  1. ;
  1. LOC(X) ;
  1. ;----- RETURN LOCATION OF ENCOUNTER FROM VISIT FILE
  1. ;
  1. ; X = VISIT IEN
  1. ;
  1. N Y
  1. S Y=""
  1. I $G(X) S Y=$P($G(^AUPNVSIT(X,0)),U,6)
  1. Q Y
  1. ;
  1. LOCN(X) ;
  1. ;----- RETURN LOCATION NAME
  1. ;
  1. ; X = LOCATION IEN
  1. ;
  1. N Y
  1. S Y=""
  1. I $G(X) D
  1. . S Y=$P($G(^AUTTLOC(X,0)),U)
  1. . I Y S Y=$P($G(^DIC(4,Y,0)),U)
  1. Q Y
  1. ;
  1. LOCP(X) ;
  1. ;----- RETURN LOCATION OF ENCOUNTER FROM INSIDE PRESCRIPTION FILE
  1. ;
  1. ; X = PRESCRIPTION IEN
  1. ;
  1. N Y,Z
  1. S Y=""
  1. I $G(X) D
  1. . S Z=$P($G(^PSRX(X,999999911)),U)
  1. . I Z S Y=$$LOCVM(Z)
  1. Q Y
  1. ;
  1. LOCR(D0,D1) ;
  1. ;----- RETURN LOCATION OF ENCOUNTER FROM INSIDE REFILL SUBFILE OF
  1. ; PRESCRIPTION FILE
  1. ;
  1. ; D0 = PRESCRIPTION IEN
  1. ; D1 = REFILL IEN
  1. ;
  1. N Y
  1. S Y=""
  1. I $G(D0),$G(D1) D
  1. . S Z=$P($G(^PSRX(D0,1,D1,999999911)),U)
  1. . I Z S Y=$$LOCVM(Z)
  1. Q Y
  1. ;
  1. LOCVM(X) ;
  1. ;----- RETURN LOCATION OF ENCOUNTER FROM INSIDE V MEDICATION FILE
  1. ;
  1. ; X = V MEDICATION IEN
  1. ;
  1. N Y,Z
  1. S Y=""
  1. I $G(X) D
  1. . S Z=$P($G(^AUPNVMED(X,0)),U,3)
  1. . I Z S Y=$P($G(^AUPNVSIT(Z,0)),U,6)
  1. Q Y
  1. ;
  1. NDC(X) ;
  1. ;----- RETURN NDC CODE
  1. ;
  1. ; X = DRUG IEN
  1. ;
  1. N Y
  1. S Y=""
  1. I $G(X) S Y=$P($G(^PSDRUG(X,2)),U,4)
  1. Q Y
  1. PATH(X) ;
  1. ;
  1. ; X = RPMS SITE IEN
  1. ;
  1. N Y
  1. S Y=""
  1. ;
  1. I $G(X) D
  1. . ;I X=2906 S Y="C:\inetpub\ftproot\pub\" ;PARKER ON phxed
  1. . I X=3018 S Y="E:\pub\" ;WHITERIVER
  1. . I X=2898 S Y="c:\inetpub\ftproot\pub\" ;ELKO
  1. . I X=2869 S Y="c:\inetpub\ftproot\pub\" ;FT DUCHESNE
  1. . I X=3050 S Y="d:\pub\" ;FT YUMA
  1. . I X=2872 S Y="/usr/spool/uucppublic/" ;HOPI
  1. . I X=7150 S Y="d:\pub\" ;OWYHEE
  1. . I X=2906 S Y="/usr/spool/uucppublic/" ;PARKER
  1. . I X=2955 S Y="/usr/spool/uucppublic/" ;SACATON (IHS)
  1. . I X=6283 S Y="/usr/spool/uucppublic/" ;SACATON (638)
  1. . I X=2967 S Y="d:\pub\" ;SAN CARLOS (IHS)
  1. . I X=6622 S Y="d:\pub\" ;SAN CARLOS (638)
  1. . I X=3000 S Y="/usr/spool/uucppublic/" ;SCHURZ
  1. . I X=5621 S Y="/usr/spool/uucppublic/" ;SCHURZ (WALKER RIVER)
  1. . I X=3018 S Y="e:\pub\" ;WHITERIVER
  1. . I X=6600 S Y="c:\inetpub\ftproot\pub\" ;CEDAR CITY (FT DUCHESNE)
  1. . I X=3245 S Y="/usr/spool/uucppublic/" ;WASHOE (SCHURZ)
  1. . I X=3246 S Y="/usr/spool/uucppublic/" ;RENO/SPARKS (SCHURZ)
  1. . I X=3008 S Y="/usr/spool/uucppublic/" ;FALLON (SCHURZ)
  1. . I X=2917 S Y="d:\pub\" ;PIMC
  1. ;
  1. Q Y
  1. ;
  1. PICD(X) ;
  1. ;----- RESOLVE ICD PROCEDURE CODE POINTER
  1. ;
  1. ; X = INTERNAL ICD PROCEDURE CODE
  1. ;
  1. N Y
  1. S Y=""
  1. I $G(X) S Y=$P($G(^ICD0(X,0)),U)
  1. Q Y
  1. ;
  1. SCAT(X) ;
  1. ;----- RETURN EXTERNAL SERVICE CATEGORY
  1. ;
  1. ; X = INTERNAL SERVICE CATETORY
  1. ;
  1. N Y,Z
  1. S Y=""
  1. I $G(X)]"" D
  1. . S Z=$P($G(^DD(9000010,.07,0)),U,3)
  1. . S Z=$P(Z,X_":",2)
  1. . S Z=$P(Z,";")
  1. . S Y=Z
  1. Q Y
  1. ;
  1. SCATP(X) ;
  1. ;----- RETURN EXTERNAL SERVICE CATEGORY FROM INSIDE PRESCRIPTION FILE
  1. ;
  1. ; X = PRESCRIPTION IEN
  1. ;
  1. N Y,Z
  1. S Y=""
  1. I $G(X) D
  1. . S Z=$P($G(^PSRX(X,999999911)),U)
  1. . I Z S Y=$$SCATVM(Z)
  1. Q Y
  1. ;
  1. SCATR(D0,D1) ;
  1. ;----- RETURN EXERNAL SERVICE CATEGORY FROM INSIDE REFILL SUBFILE OF
  1. ; PRESCRIPTION FILE
  1. ;
  1. ; D0 = PRESCRIPTION IEN
  1. ; D1 = REFILL IEN
  1. ;
  1. N Y,Z
  1. S Y=""
  1. I $G(D0),$G(D1) D
  1. . S Z=$P($G(^PSRX(D0,1,D1,999999911)),U)
  1. . I Z S Y=$$SCATVM(Z)
  1. Q Y
  1. ;
  1. SCATV(X) ;
  1. ;----- RETURN SERVICE CATEGORY FROM INSIDE VISIT FILE
  1. ;
  1. ; X = VISIT IEN
  1. ;
  1. S Y=""
  1. I $G(X) S Y=$P($G(^AUPNVSIT(X,0)),U,7)
  1. Q Y
  1. ;
  1. SCATVM(X) ;
  1. ;----- RETURN EXTERNAL SERVICE CATEGORY FROM INSIDE V MEDICATION FILE
  1. ;
  1. ; X = V MEDICATION FILE IEN
  1. ;
  1. N Y,Z
  1. S Y=""
  1. I $G(X) D
  1. . S Z=$P($G(^AUPNVMED(X,0)),U,3)
  1. . I Z S Z=$P($G(^AUPNVSIT(Z,0)),U,7)
  1. . I Z]"" S Z=$$SCAT(Z)
  1. . I Z]"" S Y=Z
  1. Q Z
  1. ;
  1. SEX(X) ;
  1. ;----- RETURN PATIENT'S SEX
  1. ;
  1. ; X = PATIENT IEN
  1. ;
  1. N Y
  1. S Y=""
  1. I $G(X) S Y=$P($G(^DPT(X,0)),U,2)
  1. Q Y
  1. ;
  1. SITE() ;
  1. ;----- RETURNS LOCATION IEN
  1. ;
  1. Q $P($G(^AUTTSITE(1,0)),U)
  1. ;
  1. SLDATE(X) ;
  1. ;----- RETURNS DATE IN MM/DD/YYYY FORMAT
  1. ;
  1. ; X = INTERNAL FILEMANAGER DATE IN YYYMMDD FORMAT
  1. ;
  1. N Y
  1. S Y=""
  1. I $G(X) D
  1. . Q:$L(X)'=7
  1. . S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_($E(X,1,3)+1700)
  1. Q Y
  1. ;
  1. UID(X) ;
  1. ;----- CALCULATE UNIQUE PATIENT ID USING LOCATION IEN AND DFN
  1. ; Returns a 13 digit unique patient ID where:
  1. ; 1st digit = 1 (so that number never starts with zero)
  1. ; 2-5 digits = 4 character location IEN (padded with zeros)
  1. ; 6-13 digits = 8 character DFN (padded with zeros)
  1. ;
  1. ; INPUT:
  1. ; X = DFN (PATIENT IEN)
  1. ;
  1. N S,Y
  1. S Y=""
  1. I $G(X) D
  1. . S X=$E("00000000",1,8-$L(X))_X
  1. . S S=$$SITE
  1. . S S=$E("0000",1,4-$L(S))_S
  1. . S Y=1_S_X
  1. Q Y
  1. ;
  1. VISDT(X) ;
  1. ;----- RETURN VISIT DATE
  1. ;
  1. ; X = VISIT IEN
  1. ;
  1. N Y
  1. S Y=""
  1. I $G(X) S Y=$P($G(^AUPNVSIT(X,0)),U)
  1. Q Y