- ONCOCOC ;Hines OIFO/GWB - COMPUTED FIELDS FOR CASEFINDING REPORTS ;05/25/00
- ;;2.2;ONCOLOGY;**1,7**;Jul 31, 2013;Build 5
- ;
- LAB ;LAB CASEFINDING REPORT (160,53)
- N X
- D GET G EX:O2=""
- S SR=$P(O2,U,3) G EX:$E(SR,1)'="L"
- S SR=$E(SR,2),LRSS=$S(SR="S":"SP",SR="C":"CY",SR="E":"EM",1:"AU")
- S XDT=$P(O2,U,1),MO=$P(O2,U,5),TO=$P(O2,U,6),DZ=$P(O2,U,14)
- S TO=$S(TO="":"None",1:"T-"_$P(^LAB(61,+TO,0),U,2)_" "_$P(^LAB(61,+TO,0),U,1))
- S MODZ="None"
- I MO S MODZ=$G(^LAB(61.1,+MO,0)),MODZ=$E($P(MODZ,U,2),1,4)_"/"_$E($P(MODZ,U,2),5)_" "_$P(MODZ,U,1)
- I DZ S MODZ=$G(^LAB(61.4,+DZ,0)),MODZ=$P(MODZ,U,2)_" "_$P(MODZ,U,1)
- D DT
- W $E(XNM,1,20),?22,$E(XSN,1,6),?29,XDT,?44,LRSS
- I $D(^ONCO(165.5,"C",D0)) D DLC^ONCOCRF,DATEOT^ONCOES W ?54,X
- W !
- W "Topography:",?12,TO,!
- W:MO "Morphology:",?13,MODZ
- W:DZ "Disease:",?15,MODZ
- D SDD^ONCOCOM
- W !,"-------------------------------------------------------------------------------"
- W ! G EX
- ;
- PTF ;PTF CASEFINDING REPORT (160,54)
- N ONCIC
- D GET G EX:O2=""
- S SR=$P(O2,U,3) G EX:$E(SR,1)'="P"
- S ONCIC=$$GET1^DIQ(80,+$P(O2,U,9),.01,"I")
- S IC=$$ICDDX^ICDEXC(ONCIC) G EX:+IC=-1
- S XDT=+$P(O2,U,8)
- D DT
- S XDD=XDT,XDT=$P(O2,U,1)
- D DT
- W $E(XNM,1,20),?22,XSN,?29,XDT_" - "_XDD,!
- W "Diagnosis:",?11,$P(IC,U,2),?19,$P(IC,U,4),!!
- G LST
- ;
- RAD ;RADIOLOGY CASEFINDING REPORT (160,58)
- D GET G EX:O2=""
- S SR=$P(O2,U,3) G EX:$E(SR,1)'="R"
- S XDT=$P(O2,U,1),RAD=$P($G(^RAMIS(71,+$P(O2,U,7),0)),U) G EX:RAD=""
- D DT
- ;B "L"
- W $E(XNM,1,29),?31,XSN,?38,XDT,?50,$E(RAD,1,30)
- G LST
- ;
- GET ;Set variables
- S XD0=$G(^ONCO(160,D0,0)),GLO="" I XD0="" Q
- S LRDFN=$P(XD0,U,2)
- S VPR=$P(XD0,U)
- S GLO=U_$P(VPR,";",2)_$P(VPR,";"),GL0=GLO_",0)"
- S XPI=$G(@GL0),XNM=$P(XPI,U),SN=$P(XPI,U,9),XSN=$E(XNM,1)_$E(SN,6,9)
- S O2="" I $D(^ONCO(160,D0,"SUS","C",DUZ(2))) D K SUSIEN
- .S SUSIEN=$O(^ONCO(160,D0,"SUS","C",DUZ(2),0))
- .S O2=^ONCO(160,D0,"SUS",SUSIEN,0)
- Q
- ;
- DT ;Format date
- S XDT=$E(XDT,4,5)_"/"_$E(XDT,6,7)_"/"_($E(XDT,1,3)+1700)
- Q
- ;
- LST ;Display DATE LAST CONTACT (160,16) and primary list
- G EX:'$D(^ONCO(165.5,"C",D0))
- D DLC^ONCOCRF,DATEOT^ONCOES
- W !!?25,"Last Contact: ",X
- D SDD^ONCOCOM
- W ! G EX
- ;
- EX ;Exit
- S X=""
- K DZ,GL0,GLO,IC,LRDFN,LRSS,MO,MODZ,O2,RAD,SN,SR,TO,VPR,XDT,XD0,XDD,XMO
- K XM1,XNM,XPI,XSN
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOCOC 2325 printed Jan 18, 2025@03:25:45 Page 2
- ONCOCOC ;Hines OIFO/GWB - COMPUTED FIELDS FOR CASEFINDING REPORTS ;05/25/00
- +1 ;;2.2;ONCOLOGY;**1,7**;Jul 31, 2013;Build 5
- +2 ;
- LAB ;LAB CASEFINDING REPORT (160,53)
- +1 NEW X
- +2 DO GET
- if O2=""
- GOTO EX
- +3 SET SR=$PIECE(O2,U,3)
- if $EXTRACT(SR,1)'="L"
- GOTO EX
- +4 SET SR=$EXTRACT(SR,2)
- SET LRSS=$SELECT(SR="S":"SP",SR="C":"CY",SR="E":"EM",1:"AU")
- +5 SET XDT=$PIECE(O2,U,1)
- SET MO=$PIECE(O2,U,5)
- SET TO=$PIECE(O2,U,6)
- SET DZ=$PIECE(O2,U,14)
- +6 SET TO=$SELECT(TO="":"None",1:"T-"_$PIECE(^LAB(61,+TO,0),U,2)_" "_$PIECE(^LAB(61,+TO,0),U,1))
- +7 SET MODZ="None"
- +8 IF MO
- SET MODZ=$GET(^LAB(61.1,+MO,0))
- SET MODZ=$EXTRACT($PIECE(MODZ,U,2),1,4)_"/"_$EXTRACT($PIECE(MODZ,U,2),5)_" "_$PIECE(MODZ,U,1)
- +9 IF DZ
- SET MODZ=$GET(^LAB(61.4,+DZ,0))
- SET MODZ=$PIECE(MODZ,U,2)_" "_$PIECE(MODZ,U,1)
- +10 DO DT
- +11 WRITE $EXTRACT(XNM,1,20),?22,$EXTRACT(XSN,1,6),?29,XDT,?44,LRSS
- +12 IF $DATA(^ONCO(165.5,"C",D0))
- DO DLC^ONCOCRF
- DO DATEOT^ONCOES
- WRITE ?54,X
- +13 WRITE !
- +14 WRITE "Topography:",?12,TO,!
- +15 if MO
- WRITE "Morphology:",?13,MODZ
- +16 if DZ
- WRITE "Disease:",?15,MODZ
- +17 DO SDD^ONCOCOM
- +18 WRITE !,"-------------------------------------------------------------------------------"
- +19 WRITE !
- GOTO EX
- +20 ;
- PTF ;PTF CASEFINDING REPORT (160,54)
- +1 NEW ONCIC
- +2 DO GET
- if O2=""
- GOTO EX
- +3 SET SR=$PIECE(O2,U,3)
- if $EXTRACT(SR,1)'="P"
- GOTO EX
- +4 SET ONCIC=$$GET1^DIQ(80,+$PIECE(O2,U,9),.01,"I")
- +5 SET IC=$$ICDDX^ICDEXC(ONCIC)
- if +IC=-1
- GOTO EX
- +6 SET XDT=+$PIECE(O2,U,8)
- +7 DO DT
- +8 SET XDD=XDT
- SET XDT=$PIECE(O2,U,1)
- +9 DO DT
- +10 WRITE $EXTRACT(XNM,1,20),?22,XSN,?29,XDT_" - "_XDD,!
- +11 WRITE "Diagnosis:",?11,$PIECE(IC,U,2),?19,$PIECE(IC,U,4),!!
- +12 GOTO LST
- +13 ;
- RAD ;RADIOLOGY CASEFINDING REPORT (160,58)
- +1 DO GET
- if O2=""
- GOTO EX
- +2 SET SR=$PIECE(O2,U,3)
- if $EXTRACT(SR,1)'="R"
- GOTO EX
- +3 SET XDT=$PIECE(O2,U,1)
- SET RAD=$PIECE($GET(^RAMIS(71,+$PIECE(O2,U,7),0)),U)
- if RAD=""
- GOTO EX
- +4 DO DT
- +5 ;B "L"
- +6 WRITE $EXTRACT(XNM,1,29),?31,XSN,?38,XDT,?50,$EXTRACT(RAD,1,30)
- +7 GOTO LST
- +8 ;
- GET ;Set variables
- +1 SET XD0=$GET(^ONCO(160,D0,0))
- SET GLO=""
- IF XD0=""
- QUIT
- +2 SET LRDFN=$PIECE(XD0,U,2)
- +3 SET VPR=$PIECE(XD0,U)
- +4 SET GLO=U_$PIECE(VPR,";",2)_$PIECE(VPR,";")
- SET GL0=GLO_",0)"
- +5 SET XPI=$GET(@GL0)
- SET XNM=$PIECE(XPI,U)
- SET SN=$PIECE(XPI,U,9)
- SET XSN=$EXTRACT(XNM,1)_$EXTRACT(SN,6,9)
- +6 SET O2=""
- IF $DATA(^ONCO(160,D0,"SUS","C",DUZ(2)))
- Begin DoDot:1
- +7 SET SUSIEN=$ORDER(^ONCO(160,D0,"SUS","C",DUZ(2),0))
- +8 SET O2=^ONCO(160,D0,"SUS",SUSIEN,0)
- End DoDot:1
- KILL SUSIEN
- +9 QUIT
- +10 ;
- DT ;Format date
- +1 SET XDT=$EXTRACT(XDT,4,5)_"/"_$EXTRACT(XDT,6,7)_"/"_($EXTRACT(XDT,1,3)+1700)
- +2 QUIT
- +3 ;
- LST ;Display DATE LAST CONTACT (160,16) and primary list
- +1 if '$DATA(^ONCO(165.5,"C",D0))
- GOTO EX
- +2 DO DLC^ONCOCRF
- DO DATEOT^ONCOES
- +3 WRITE !!?25,"Last Contact: ",X
- +4 DO SDD^ONCOCOM
- +5 WRITE !
- GOTO EX
- +6 ;
- EX ;Exit
- +1 SET X=""
- +2 KILL DZ,GL0,GLO,IC,LRDFN,LRSS,MO,MODZ,O2,RAD,SN,SR,TO,VPR,XDT,XD0,XDD,XMO
- +3 KILL XM1,XNM,XPI,XSN
- +4 QUIT