AGEDPRVU.m

AGEDPRVU ;IHS/ASDS/TPF - EDIT/DISPLAY PRIVATE INSURANCE UTIL ;    

 ;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007

 Q

HDR(ID0) ;EP - CALLED BY AGEDPRV

 I $G(AGSELECT)'="" S INSREC=$P($P($G(AGSELECT),U,11),",",3),AGELP("PH")=$S('$D(^AUPNPRVT(ID0,11,INSREC,0)):"",1:$P($G(^(0)),U,8)),AGELP("INS")=$S(AGELP("PH")]"":$P($G(^(0)),U),1:"")

 I $G(ID0)'="" D

 .S AGPAT=$P($G(^DPT(ID0,0)),U)

 .S AGCHRT=$S($D(^AUPNPAT(ID0,41,DUZ(2),0)):$P($G(^AUPNPAT(ID0,41,DUZ(2),0)),U,2),1:"xxxxx")

 .S:$D(^AUPNPAT(ID0,0)) AG("AUPN")=$G(^(0))

 S AG("AUPN")=""

 S AGLINE("-")=$TR($J(" ",78)," ","-")

 S AGLINE("EQ")=$TR($J(" ",78)," ","=")

 S $P(AGLINE("PGLN"),"=",81)=""

 W $$S^AGVDF("IOF"),!

 S ROUTID=$P($T(+1)," ")

 S SUBS=$P($G(AGSELECT),U,11)

 D PROGVIEW^AGUTILS(DUZ,SUBS)

 W "IHS REGISTRATION ",$S($D(AGSEENLY):"VIEW SCREEN",1:"EDITOR")

 ;MODIFY THIS TO BE SPECIFIC TO YOUR EDIT SCREEN

 W ?36,"Private Insurance"

 W ?80-$L($P($G(^DIC(4,DUZ(2),0)),U)),$P($G(^DIC(4,DUZ(2),0)),U)

 S AGLINE("-")=$TR($J(" ",80)," ","-")

 S AGLINE("EQ")=$TR($J(" ",80)," ","=")

 W !,AGLINE("EQ")

 W !,$E(AGPAT,1,23)

 W ?23,$$DTEST^AGUTILS(ID0)

 I $D(AGCHRT) W ?42,"HRN#:",AGCHRT

 ;GET ELIGIBILITY STATUS

 I ID0 S AGELSTS=$P($G(^AUPNPAT(ID0,11)),U,12)

 W ?56,"(",$S(AGELSTS="C":"CHS & DIRECT",AGELSTS="I":"INELIGIBLE",AGELSTS="D":"DIRECT ONLY",AGELSTS="P":"PENDING VERIFICATION",1:"NONE"),")"

 W !,AGLINE("EQ")

 S DA=ID0

 K AG("EDIT"),INSREC

 Q

AGEDPRVU  ;IHS/ASDS/TPF - EDIT/DISPLAY PRIVATE INSURANCE UTIL ;    

 +1       ;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007

 +2        QUIT 

HDR(ID0)  ;EP - CALLED BY AGEDPRV

 +1        IF $GET(AGSELECT)'=""

               SET INSREC=$PIECE($PIECE($GET(AGSELECT),U,11),",",3)

               SET AGELP("PH")=$SELECT('$DATA(^AUPNPRVT(ID0,11,INSREC,0)):"",1:$PIECE($GET(^(0)),U,8))

               SET AGELP("INS")=$SELECT(AGELP("PH")]"":$PIECE($GET(^(0)),U),1:"")

 +2        IF $GET(ID0)'=""

               Begin DoDot:1

 +3                SET AGPAT=$PIECE($GET(^DPT(ID0,0)),U)

 +4                SET AGCHRT=$SELECT($DATA(^AUPNPAT(ID0,41,DUZ(2),0)):$PIECE($GET(^AUPNPAT(ID0,41,DUZ(2),0)),U,2),1:"xxxxx")

 +5                IF $DATA(^AUPNPAT(ID0,0))

                       SET AG("AUPN")=$GET(^(0))

               End DoDot:1

 +6        SET AG("AUPN")=""

 +7        SET AGLINE("-")=$TRANSLATE($JUSTIFY(" ",78)," ","-")

 +8        SET AGLINE("EQ")=$TRANSLATE($JUSTIFY(" ",78)," ","=")

 +9        SET $PIECE(AGLINE("PGLN"),"=",81)=""

 +10       WRITE $$S^AGVDF("IOF"),!

 +11       SET ROUTID=$PIECE($TEXT(+1)," ")

 +12       SET SUBS=$PIECE($GET(AGSELECT),U,11)

 +13       DO PROGVIEW^AGUTILS(DUZ,SUBS)

 +14       WRITE "IHS REGISTRATION ",$SELECT($DATA(AGSEENLY):"VIEW SCREEN",1:"EDITOR")

 +15      ;MODIFY THIS TO BE SPECIFIC TO YOUR EDIT SCREEN

 +16       WRITE ?36,"Private Insurance"

 +17       WRITE ?80-$LENGTH($PIECE($GET(^DIC(4,DUZ(2),0)),U)),$PIECE($GET(^DIC(4,DUZ(2),0)),U)

 +18       SET AGLINE("-")=$TRANSLATE($JUSTIFY(" ",80)," ","-")

 +19       SET AGLINE("EQ")=$TRANSLATE($JUSTIFY(" ",80)," ","=")

 +20       WRITE !,AGLINE("EQ")

 +21       WRITE !,$EXTRACT(AGPAT,1,23)

 +22       WRITE ?23,$$DTEST^AGUTILS(ID0)

 +23       IF $DATA(AGCHRT)

               WRITE ?42,"HRN#:",AGCHRT

 +24      ;GET ELIGIBILITY STATUS

 +25       IF ID0

               SET AGELSTS=$PIECE($GET(^AUPNPAT(ID0,11)),U,12)

 +26       WRITE ?56,"(",$SELECT(AGELSTS="C":"CHS & DIRECT",AGELSTS="I":"INELIGIBLE",AGELSTS="D":"DIRECT ONLY",AGELSTS="P":"PENDING VERIFICATION",1:"NONE"),")"

 +27       WRITE !,AGLINE("EQ")

 +28       SET DA=ID0

 +29       KILL AG("EDIT"),INSREC

 +30       QUIT