BLRSHPL2 ;cmi/anch/maw - BLR Reference Lab Shipping Manifest: Others ; 20-May-2016 07:17 ; MKK
;;5.2;IHS LABORATORY;**1027,1028,1031,1034,1039**;NOV 01, 1997;Build 38
;
;
;
WA ;-- print labcorp written authorization
W !!
W "I hereby authorize the release of medical information related to the services"
W !,"described herein and authorize payment directly to Laboratory Corporation of"
W !,"America. I agree to assume responsibility for payment of charges for"
W !,"laboratory services that are not covered by any healthcare insurer."
W !!!
W "____________________ __________",?40,"___________________ __________"
W !,"Patient Signature Date",?40,"Physician Signature Date"
Q
;
PRTSECI(SEC,PT) ;-- print the secondary insurance
N INSI,ICC,IN,IR,IRE,INRN,INRA,INRAE,INSAD,INSADE,GUARI,GUAR,GUARA,GUARAE,GUARPH,ING,INID,GUARP
N INST
S INSI=$P(SEC,U,2)
S ICC=$TR($P($G(^AUTNINS(INSI,2)),U,19),"~")
S IR=$S($P(SEC,U,16):$P($G(^AUTTRLSH($P(SEC,U,16),0)),U),1:"")
I $G(IR)]"" D
. I IR="SELF" S IR=1 Q
. I IR="SPOUSE" S IR=2,IRE="SPOUSE" Q
. I IR="HUSBAND" S IR=2,IRE="SPOUSE" Q
. I IR="WIFE" S IR=2,IRE="SPOUSE" Q
. S IR=3,IRE="OTHER" Q
I $G(IR)="" S IR=1,IRE="SELF"
S INRN=$P($G(^AUTNINS(INSI,0)),U)
S INRA=$$PATADD^BLRRLHL(PT)
S INRAE=$TR($P($$PATADD^BLRRLHL(PT),U),U," ")_"~"_$TR($P($$PATADD^BLRRLHL(PT),U,3,99),U," ")
S INSAD=$$INSADD^BLRRLHL(INSI)
S INSADE=$TR($P(INSAD,U),U," ")_"~"_$TR($P(INSAD,U,3,99),U," ")
S GUARI=$P(SEC,U,7)
S INST=$P($G(^AUTNINS(INSI,2)),U)
I $E(GUARI,1,1)="P" D
. S GUAR=$$HLNAME^XLFNAME($P(^AUPN3PPH($E(GUARI,2,99),0),U))
. S GUARAD=$$GT1ADD^BLRRLHL($E(GUARI,2,99))
. S GUARPH=$P($G(^AUPN3PPH($E(GUARI,2,99),0)),U,14)
. ;D INSTYP(BLRTSTDA)
. S GUARAE=$TR($P($G(GUARA),U),U," ")_"~"_$TR($P($G(GUARA),U,3,99),U," ")
. S GUARE=$TR($G(GUAR),U," ")
I GUARI]"",$E(GUARI,1,1)'="P" D
. S GUAR=$P(^DPT(PT,0),U)
. S GUARA=$$PATADD^BLRRLHL(PT)
. S GUARPH=$P($G(^DPT(PT,.131)),U)
I GUAR="" D
. S GUAR=$P($G(^DPT(PT,0)),U)
. S GUARA=$G(INRAE)
;D INSTYP(BLRTSTDA)
S GUARAE=$TR($P($G(GUARA),U),U," ")_"~"_$TR($P($G(GUARA),U,3,99),U," ")
S GUARE=$TR($G(GUAR),U," ")
S ING=$P(SEC,U,20)
S INID=$P(SEC,U,9)
W !!,"SECONDARY INSURANCE"
W !,"Ins Carrier Code: "_$G(ICC),?40,"Insured Name: "_$E($P($G(^DPT(PT,0)),U),1,26)
W !,?40,"Relationship: "_$G(IRE)
W !,"Insurer Name: ",$E($G(INRN),1,30),?40,"Insured Add: "_$P(INRAE,"~")
W !,"Insurer Add: ",?54,$P(INRAE,"~",2)
W !,$P($G(INSADE),"~"),?40,"Guarantor: "_$E($G(GUARE),1,25)
W !,$P($G(INSADE),"~",2),?40,"Guar Add: "_$P($G(GUARAE),"~")
W !,"Insurer Group: "_$G(ING),?50,$P($G(GUARE),"~",2)
W !,"Insured ID: "_$G(INID),?40,"Guarantor Phone: "_$G(GUARPH)
Q
BLRSHPL2 ;cmi/anch/maw - BLR Reference Lab Shipping Manifest: Others ; 20-May-2016 07:17 ; MKK
+1 ;;5.2;IHS LABORATORY;**1027,1028,1031,1034,1039**;NOV 01, 1997;Build 38
+2 ;
+3 ;
+4 ;
WA ;-- print labcorp written authorization
+1 WRITE !!
+2 WRITE "I hereby authorize the release of medical information related to the services"
+3 WRITE !,"described herein and authorize payment directly to Laboratory Corporation of"
+4 WRITE !,"America. I agree to assume responsibility for payment of charges for"
+5 WRITE !,"laboratory services that are not covered by any healthcare insurer."
+6 WRITE !!!
+7 WRITE "____________________ __________",?40,"___________________ __________"
+8 WRITE !,"Patient Signature Date",?40,"Physician Signature Date"
+9 QUIT
+10 ;
PRTSECI(SEC,PT) ;-- print the secondary insurance
+1 NEW INSI,ICC,IN,IR,IRE,INRN,INRA,INRAE,INSAD,INSADE,GUARI,GUAR,GUARA,GUARAE,GUARPH,ING,INID,GUARP
+2 NEW INST
+3 SET INSI=$PIECE(SEC,U,2)
+4 SET ICC=$TRANSLATE($PIECE($GET(^AUTNINS(INSI,2)),U,19),"~")
+5 SET IR=$SELECT($PIECE(SEC,U,16):$PIECE($GET(^AUTTRLSH($PIECE(SEC,U,16),0)),U),1:"")
+6 IF $GET(IR)]""
Begin DoDot:1
+7 IF IR="SELF"
SET IR=1
QUIT
+8 IF IR="SPOUSE"
SET IR=2
SET IRE="SPOUSE"
QUIT
+9 IF IR="HUSBAND"
SET IR=2
SET IRE="SPOUSE"
QUIT
+10 IF IR="WIFE"
SET IR=2
SET IRE="SPOUSE"
QUIT
+11 SET IR=3
SET IRE="OTHER"
QUIT
End DoDot:1
+12 IF $GET(IR)=""
SET IR=1
SET IRE="SELF"
+13 SET INRN=$PIECE($GET(^AUTNINS(INSI,0)),U)
+14 SET INRA=$$PATADD^BLRRLHL(PT)
+15 SET INRAE=$TRANSLATE($PIECE($$PATADD^BLRRLHL(PT),U),U," ")_"~"_$TRANSLATE($PIECE($$PATADD^BLRRLHL(PT),U,3,99),U," ")
+16 SET INSAD=$$INSADD^BLRRLHL(INSI)
+17 SET INSADE=$TRANSLATE($PIECE(INSAD,U),U," ")_"~"_$TRANSLATE($PIECE(INSAD,U,3,99),U," ")
+18 SET GUARI=$PIECE(SEC,U,7)
+19 SET INST=$PIECE($GET(^AUTNINS(INSI,2)),U)
+20 IF $EXTRACT(GUARI,1,1)="P"
Begin DoDot:1
+21 SET GUAR=$$HLNAME^XLFNAME($PIECE(^AUPN3PPH($EXTRACT(GUARI,2,99),0),U))
+22 SET GUARAD=$$GT1ADD^BLRRLHL($EXTRACT(GUARI,2,99))
+23 SET GUARPH=$PIECE($GET(^AUPN3PPH($EXTRACT(GUARI,2,99),0)),U,14)
+24 ;D INSTYP(BLRTSTDA)
+25 SET GUARAE=$TRANSLATE($PIECE($GET(GUARA),U),U," ")_"~"_$TRANSLATE($PIECE($GET(GUARA),U,3,99),U," ")
+26 SET GUARE=$TRANSLATE($GET(GUAR),U," ")
End DoDot:1
+27 IF GUARI]""
IF $EXTRACT(GUARI,1,1)'="P"
Begin DoDot:1
+28 SET GUAR=$PIECE(^DPT(PT,0),U)
+29 SET GUARA=$$PATADD^BLRRLHL(PT)
+30 SET GUARPH=$PIECE($GET(^DPT(PT,.131)),U)
End DoDot:1
+31 IF GUAR=""
Begin DoDot:1
+32 SET GUAR=$PIECE($GET(^DPT(PT,0)),U)
+33 SET GUARA=$GET(INRAE)
End DoDot:1
+34 ;D INSTYP(BLRTSTDA)
+35 SET GUARAE=$TRANSLATE($PIECE($GET(GUARA),U),U," ")_"~"_$TRANSLATE($PIECE($GET(GUARA),U,3,99),U," ")
+36 SET GUARE=$TRANSLATE($GET(GUAR),U," ")
+37 SET ING=$PIECE(SEC,U,20)
+38 SET INID=$PIECE(SEC,U,9)
+39 WRITE !!,"SECONDARY INSURANCE"
+40 WRITE !,"Ins Carrier Code: "_$GET(ICC),?40,"Insured Name: "_$EXTRACT($PIECE($GET(^DPT(PT,0)),U),1,26)
+41 WRITE !,?40,"Relationship: "_$GET(IRE)
+42 WRITE !,"Insurer Name: ",$EXTRACT($GET(INRN),1,30),?40,"Insured Add: "_$PIECE(INRAE,"~")
+43 WRITE !,"Insurer Add: ",?54,$PIECE(INRAE,"~",2)
+44 WRITE !,$PIECE($GET(INSADE),"~"),?40,"Guarantor: "_$EXTRACT($GET(GUARE),1,25)
+45 WRITE !,$PIECE($GET(INSADE),"~",2),?40,"Guar Add: "_$PIECE($GET(GUARAE),"~")
+46 WRITE !,"Insurer Group: "_$GET(ING),?50,$PIECE($GET(GUARE),"~",2)
+47 WRITE !,"Insured ID: "_$GET(INID),?40,"Guarantor Phone: "_$GET(GUARPH)
+48 QUIT
