ONCOCOP ;WASH ISC/SRR,MLH-COMPUTED FIELDS FOR 165.5, DIRECT TO VARPRT ;8/9/93 09:49
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
GETPT ;GET POINTERS
S X=$P($G(^ONCO(165.5,D0,0)),U,2),X=$P($G(^ONCO(160,+X,0)),U) Q:X="" S DFN=$P(X,";"),OVR="^"_$P(X,";",2)_DFN_","
Q
;
PID ;PATIENT ID (FIRST DIGIT LAST NAME,PLUS LAST 4 SSN
D GETPT G EX:X="" S OVR=OVR_"0)",PD0=@OVR,X=$E($P(PD0,U),1)_$E($P(PD0,U,9),6,9) G EX
Q
STCT ;STATE-COUNTY FROM MAS DATA
D GETPT G EX:X="" S OVR=OVR_".11)",O11=$G(@OVR),(OS,X)=$P(O11,U,5) G EX:X="" S (OC,X)=$P(O11,U,7) G EX:X="" S (OC,X)=$P($G(^DIC(5,OS,1,OC,0)),U) G EX:X="" S X=$P(^DIC(5,OS,0),U,2) G EX:X="" S X=X_"/"_OC G EX
W !,"CTY=",X ;S OC=X$P($G(^DIC(5,OS,0)),U,2) G EX:X="",EX:$P(O11,U,7)="" S OCT=$O
EX ;EXIT
K DFN,OVR,OAD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOCOP 784 printed Oct 16, 2024@18:25:21 Page 2
ONCOCOP ;WASH ISC/SRR,MLH-COMPUTED FIELDS FOR 165.5, DIRECT TO VARPRT ;8/9/93 09:49
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
GETPT ;GET POINTERS
+1 SET X=$PIECE($GET(^ONCO(165.5,D0,0)),U,2)
SET X=$PIECE($GET(^ONCO(160,+X,0)),U)
if X=""
QUIT
SET DFN=$PIECE(X,";")
SET OVR="^"_$PIECE(X,";",2)_DFN_","
+2 QUIT
+3 ;
PID ;PATIENT ID (FIRST DIGIT LAST NAME,PLUS LAST 4 SSN
+1 DO GETPT
if X=""
GOTO EX
SET OVR=OVR_"0)"
SET PD0=@OVR
SET X=$EXTRACT($PIECE(PD0,U),1)_$EXTRACT($PIECE(PD0,U,9),6,9)
GOTO EX
+2 QUIT
STCT ;STATE-COUNTY FROM MAS DATA
+1 DO GETPT
if X=""
GOTO EX
SET OVR=OVR_".11)"
SET O11=$GET(@OVR)
SET (OS,X)=$PIECE(O11,U,5)
if X=""
GOTO EX
SET (OC,X)=$PIECE(O11,U,7)
if X=""
GOTO EX
SET (OC,X)=$PIECE($GET(^DIC(5,OS,1,OC,0)),U)
if X=""
GOTO EX
SET X=$PIECE(^DIC(5,OS,0),U,2)
if X=""
GOTO EX
SET X=X_"/"_OC
GOTO EX
+2 ;S OC=X$P($G(^DIC(5,OS,0)),U,2) G EX:X="",EX:$P(O11,U,7)="" S OCT=$O
WRITE !,"CTY=",X
EX ;EXIT
+1 KILL DFN,OVR,OAD
+2 QUIT
