- DGRP5 ;ALB/MRL - REGISTRATION SCREEN 5/INSURANCE INFORMATION ;06 JUN 88@2300
- ;;5.3;Registration;**190,366,570**;Aug 13, 1993
- S DGRPW=1,DGRPS=5 D H^DGRPU S Z=1 D WW^DGRPV W " Covered by Health Insurance: " S Z=$S($D(^DPT(DFN,.31)):$P(^(.31),"^",11),1:""),Z=$S(Z="Y":"YES",Z="N":"NO",Z="U":"UNKNOWN",1:"NOT ANSWERED"),Z1=15 D WW1^DGRPV
- W ! D DISP^DGIBDSP
- W ! S DGRPX=$G(^DPT(DFN,.38)),Z=2 D WW^DGRPV W " Eligible for MEDICAID: ",$S(+DGRPX:"YES",$P(DGRPX,"^",1)=0:"NO",1:DGRPU)
- S Y=$P(DGRPX,"^",2) I Y X ^DD("DD") W " [last updated ",Y,"]"
- ;; *** Added for Medicaid information
- W ! S Z=3 D WW^DGRPV W " Medicaid Number: ",$P(DGRPX,U,3) ;previous $S($P(DGRPX,U,3)>0:$P(DGRPX,U,3),1:"")
- G ^DGRPP
- IN ; This code is no longer called, replaced by DISP^IBCNSP2
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRP5 776 printed Jan 18, 2025@03:56:20 Page 2
- DGRP5 ;ALB/MRL - REGISTRATION SCREEN 5/INSURANCE INFORMATION ;06 JUN 88@2300
- +1 ;;5.3;Registration;**190,366,570**;Aug 13, 1993
- +2 SET DGRPW=1
- SET DGRPS=5
- DO H^DGRPU
- SET Z=1
- DO WW^DGRPV
- WRITE " Covered by Health Insurance: "
- SET Z=$SELECT($DATA(^DPT(DFN,.31)):$PIECE(^(.31),"^",11),1:"")
- SET Z=$SELECT(Z="Y":"YES",Z="N":"NO",Z="U":"UNKNOWN",1:"NOT ANSWERED")
- SET Z1=15
- DO WW1^DGRPV
- +3 WRITE !
- DO DISP^DGIBDSP
- +4 WRITE !
- SET DGRPX=$GET(^DPT(DFN,.38))
- SET Z=2
- DO WW^DGRPV
- WRITE " Eligible for MEDICAID: ",$SELECT(+DGRPX:"YES",$PIECE(DGRPX,"^",1)=0:"NO",1:DGRPU)
- +5 SET Y=$PIECE(DGRPX,"^",2)
- IF Y
- XECUTE ^DD("DD")
- WRITE " [last updated ",Y,"]"
- +6 ;; *** Added for Medicaid information
- +7 ;previous $S($P(DGRPX,U,3)>0:$P(DGRPX,U,3),1:"")
- WRITE !
- SET Z=3
- DO WW^DGRPV
- WRITE " Medicaid Number: ",$PIECE(DGRPX,U,3)
- +8 GOTO ^DGRPP
- IN ; This code is no longer called, replaced by DISP^IBCNSP2
- +1 QUIT