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