ABSPOSCH.m

ABSPOSCH ; IHS/FCS/DRS - Set up ABSP() ;      [ 05/09/2003  9:37 AM ]

 ;;1.0;PHARMACY POINT OF SALE;**1,4,6,9,11,15,16,17,19,20,21,29,37,40,42**;JUN 01, 2001;Build 38

 ;---

 ;Moved over subroutines from ABSPOSCC due to SAC size standards

 ;

CAIDNAME()         Q $P($G(^AUPNMCD(PINSDA,21)),U)

CAIDELDT() ;CAID ELIG BEGIN AND END DATES

 N D1,BEGDT,ENDDT

 S (BEGDT,ENDDT)=""

 S D1=$O(^AUPNMCD(PINSDA,11,"A"),-1)

 I D1 D

 . S BEGDT=$P(^AUPNMCD(PINSDA,11,D1,0),U,1)

 . S ENDDT=$P(^AUPNMCD(PINSDA,11,D1,0),U,2)

 Q BEGDT_U_ENDDT

CARENAME()         ;Q $P($G(^AUPNMCR(PINSDA,21)),U)

 N NAME,MDNAME

 S NAME=$P($G(^AUPNMCR(PINSDA,21)),U)     ;orig

 S MDNAME=""

 ;RLT 21

 ;S:MDIEN'="" MDNAME=$P($G(^AUPNMCR(PINSDA,11,MDIEN,0)),U,5)   ;MPD

 S:MDFLG&(MDIEN) MDNAME=$P($G(^AUPNMCR(PINSDA,11,MDIEN,0)),U,5)   ;MPD

 S:MDNAME'="" NAME=MDNAME

 Q NAME

 ;IHS/SD/lwj 11/25/02 get Medicaid DOB

CAIDDOB()          Q $P($G(^AUPNMCD(PINSDA,21)),U,2)  ;dob

CAREDOB() ;

 N DOB,MDDOB

 S DOB=$P($G(^AUPNMCR(PINSDA,21)),U,2)      ;orig

 S MDDOB=""

 ;RLT

 ;S:MDIEN'="" MDDOB=$P($G(^AUPNMCR(PINSDA,11,MDIEN,0)),U,9)    ;MPD

 S:MDFLG&(MDIEN) MDDOB=$P($G(^AUPNMCR(PINSDA,11,MDIEN,0)),U,9)      ;MPD

 S:MDDOB'="" DOB=MDDOB

 Q DOB

GETAINFO ;Address Info for 322,323,324 and 325 fields.

 ;

 N ABSPAREC

 S ABSPAREC=$G(^DPT(PATIEN,.11))

 Q:ABSPAREC=""

 ;

 S ABSP("Patient","Street Address")=$P(ABSPAREC,U)

 S ABSP("Patient","City")=$P(ABSPAREC,U,4)

 I $P(ABSPAREC,U,5)'="" D

 . S ABSP("Patient","State")=$P($G(^DIC(5,$P(ABSPAREC,U,5),0)),U,2)

 S ABSP("Patient","Zip")=$P(ABSPAREC,U,6)

 ;

 Q

ABSPOSCH  ; IHS/FCS/DRS - Set up ABSP() ;      [ 05/09/2003  9:37 AM ]

 +1       ;;1.0;PHARMACY POINT OF SALE;**1,4,6,9,11,15,16,17,19,20,21,29,37,40,42**;JUN 01, 2001;Build 38

 +2       ;---

 +3       ;Moved over subroutines from ABSPOSCC due to SAC size standards

 +4       ;

CAIDNAME()  QUIT $PIECE($GET(^AUPNMCD(PINSDA,21)),U)

CAIDELDT() ;CAID ELIG BEGIN AND END DATES

 +1        NEW D1,BEGDT,ENDDT

 +2        SET (BEGDT,ENDDT)=""

 +3        SET D1=$ORDER(^AUPNMCD(PINSDA,11,"A"),-1)

 +4        IF D1

               Begin DoDot:1

 +5                SET BEGDT=$PIECE(^AUPNMCD(PINSDA,11,D1,0),U,1)

 +6                SET ENDDT=$PIECE(^AUPNMCD(PINSDA,11,D1,0),U,2)

               End DoDot:1

 +7        QUIT BEGDT_U_ENDDT

CARENAME() ;Q $P($G(^AUPNMCR(PINSDA,21)),U)

 +1        NEW NAME,MDNAME

 +2       ;orig

           SET NAME=$PIECE($GET(^AUPNMCR(PINSDA,21)),U)

 +3        SET MDNAME=""

 +4       ;RLT 21

 +5       ;S:MDIEN'="" MDNAME=$P($G(^AUPNMCR(PINSDA,11,MDIEN,0)),U,5)   ;MPD

 +6       ;MPD

           IF MDFLG&(MDIEN)

               SET MDNAME=$PIECE($GET(^AUPNMCR(PINSDA,11,MDIEN,0)),U,5)

 +7        IF MDNAME'=""

               SET NAME=MDNAME

 +8        QUIT NAME

 +9       ;IHS/SD/lwj 11/25/02 get Medicaid DOB

CAIDDOB() ;dob

           QUIT $PIECE($GET(^AUPNMCD(PINSDA,21)),U,2)

CAREDOB() ;

 +1        NEW DOB,MDDOB

 +2       ;orig

           SET DOB=$PIECE($GET(^AUPNMCR(PINSDA,21)),U,2)

 +3        SET MDDOB=""

 +4       ;RLT

 +5       ;S:MDIEN'="" MDDOB=$P($G(^AUPNMCR(PINSDA,11,MDIEN,0)),U,9)    ;MPD

 +6       ;MPD

           IF MDFLG&(MDIEN)

               SET MDDOB=$PIECE($GET(^AUPNMCR(PINSDA,11,MDIEN,0)),U,9)

 +7        IF MDDOB'=""

               SET DOB=MDDOB

 +8        QUIT DOB

GETAINFO  ;Address Info for 322,323,324 and 325 fields.

 +1       ;

 +2        NEW ABSPAREC

 +3        SET ABSPAREC=$GET(^DPT(PATIEN,.11))

 +4        IF ABSPAREC=""

               QUIT 

 +5       ;

 +6        SET ABSP("Patient","Street Address")=$PIECE(ABSPAREC,U)

 +7        SET ABSP("Patient","City")=$PIECE(ABSPAREC,U,4)

 +8        IF $PIECE(ABSPAREC,U,5)'=""

               Begin DoDot:1

 +9                SET ABSP("Patient","State")=$PIECE($GET(^DIC(5,$PIECE(ABSPAREC,U,5),0)),U,2)

               End DoDot:1

 +10       SET ABSP("Patient","Zip")=$PIECE(ABSPAREC,U,6)

 +11      ;

 +12       QUIT