- ABSPOSN5 ; IHS/FCS/DRS - NCPDP Forms for ILC A/R ; [ 09/12/2002 10:16 AM ]
- ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
- Q
- EN(TITLE,PFLAG) ;EP
- ;
- N X,Y,SITE,AINS,D0,PAT,TOTPCN,FLG,PCN,PCNBAL,VCN,SUBPCN,RESP,DIR,DATE
- S Y=DT D DD^%DT S DATE=Y
- S SITE=$P($G(^ABSSETUP(9002314,1,0)),U,1)
- S SITE=$P($G(^DIC(4,SITE,0)),U,1)
- U IO
- D HDR
- D RPT
- W @IOF
- ;K ^TMP("ABSPOSN5",$J)
- Q
- ;----------------------------------------------------------------
- RPT ;
- K ^TMP("ABSPOSN5",$J)
- N AINS,D0
- S (D0,FLG("X"))=0
- F S D0=$O(^ABSBITMS(9002302,PFLAG,1,D0)) Q:'D0 DO
- . S AINS=$P($G(^ABSBITMS(9002302,D0,0)),U,3)
- . I AINS="" S AINS="SELF PAY"
- . S PAT=$P($G(^ABSBITMS(9002302,D0,0)),U,2)
- . Q:'PAT
- . S PAT=$P($G(^DPT(PAT,0)),U,1)
- . S ^TMP("ABSPOSN5",$J,AINS,PAT,D0)=""
- S AINS=""
- S TOTPCN=0
- F S AINS=$O(^TMP("ABSPOSN5",$J,AINS)) Q:AINS="" D Q:FLG("X")
- . W !,$E(AINS,1,80)
- . S PAT="",SUBPCN=0
- . F S PAT=$O(^TMP("ABSPOSN5",$J,AINS,PAT)) Q:PAT="" D Q:FLG("X")
- . . S D0=0
- . . F S D0=$O(^TMP("ABSPOSN5",$J,AINS,PAT,D0)) Q:'D0 D Q:FLG("X")
- . . . S PCN=$P($G(^ABSBITMS(9002302,D0,0)),U,1)
- . . . S PCNBAL=$P($G(^ABSBITMS(9002302,D0,3)),U,1)
- . . . Q:PCNBAL=0
- . . . S VCN=$P($G(^ABSBITMS(9002302,D0,"VCN")),U,1)
- . . . S SUBPCN=SUBPCN+PCNBAL
- . . . W !,?8,$E(PAT,1,30),?44,$E(VCN,1,12),?57,$E(PCN,1,12),?70,$J(PCNBAL,10,2)
- . . . I ($Y+6)>IOSL,$E(IOST)="P" D HDR
- . . . I ($Y+6)>IOSL,$E(IOST)="C" W *7 S DIR(0)="E" D ^DIR S RESP=Y D HDR I RESP=0 S FLG("X")=1 Q
- . W !,?70,"----------",!,"SUBTOTAL",?70,$J(SUBPCN,10,2),!
- . S TOTPCN=TOTPCN+SUBPCN
- Q:FLG("X")=1
- W !!,?70,"----------",!,"TOTAL",?70,$J(TOTPCN,10,2),!
- I $E(IOST)="C" W *7 S DIR(0)="E" D ^DIR Q:'Y
- Q
- ;----------------------------------------------------------------------
- HDR W @IOF
- W !,$E(TITLE,1,39),?40,$E(SITE,1,24),?68,$E(DATE,1,12)
- W !!,"INSURER/PATIENT",?44,"VCN",?57,"PCN",?70,"BALANCE"
- W !,$TR($J("",80)," ","-")
- Q
- ABSPOSN5 ; IHS/FCS/DRS - NCPDP Forms for ILC A/R ; [ 09/12/2002 10:16 AM ]
- +1 ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
- +2 QUIT
- EN(TITLE,PFLAG) ;EP
- +1 ;
- +2 NEW X,Y,SITE,AINS,D0,PAT,TOTPCN,FLG,PCN,PCNBAL,VCN,SUBPCN,RESP,DIR,DATE
- +3 SET Y=DT
- DO DD^%DT
- SET DATE=Y
- +4 SET SITE=$PIECE($GET(^ABSSETUP(9002314,1,0)),U,1)
- +5 SET SITE=$PIECE($GET(^DIC(4,SITE,0)),U,1)
- +6 USE IO
- +7 DO HDR
- +8 DO RPT
- +9 WRITE @IOF
- +10 ;K ^TMP("ABSPOSN5",$J)
- +11 QUIT
- +12 ;----------------------------------------------------------------
- RPT ;
- +1 KILL ^TMP("ABSPOSN5",$JOB)
- +2 NEW AINS,D0
- +3 SET (D0,FLG("X"))=0
- +4 FOR
- SET D0=$ORDER(^ABSBITMS(9002302,PFLAG,1,D0))
- IF 'D0
- QUIT
- Begin DoDot:1
- +5 SET AINS=$PIECE($GET(^ABSBITMS(9002302,D0,0)),U,3)
- +6 IF AINS=""
- SET AINS="SELF PAY"
- +7 SET PAT=$PIECE($GET(^ABSBITMS(9002302,D0,0)),U,2)
- +8 IF 'PAT
- QUIT
- +9 SET PAT=$PIECE($GET(^DPT(PAT,0)),U,1)
- +10 SET ^TMP("ABSPOSN5",$JOB,AINS,PAT,D0)=""
- End DoDot:1
- +11 SET AINS=""
- +12 SET TOTPCN=0
- +13 FOR
- SET AINS=$ORDER(^TMP("ABSPOSN5",$JOB,AINS))
- IF AINS=""
- QUIT
- Begin DoDot:1
- +14 WRITE !,$EXTRACT(AINS,1,80)
- +15 SET PAT=""
- SET SUBPCN=0
- +16 FOR
- SET PAT=$ORDER(^TMP("ABSPOSN5",$JOB,AINS,PAT))
- IF PAT=""
- QUIT
- Begin DoDot:2
- +17 SET D0=0
- +18 FOR
- SET D0=$ORDER(^TMP("ABSPOSN5",$JOB,AINS,PAT,D0))
- IF 'D0
- QUIT
- Begin DoDot:3
- +19 SET PCN=$PIECE($GET(^ABSBITMS(9002302,D0,0)),U,1)
- +20 SET PCNBAL=$PIECE($GET(^ABSBITMS(9002302,D0,3)),U,1)
- +21 IF PCNBAL=0
- QUIT
- +22 SET VCN=$PIECE($GET(^ABSBITMS(9002302,D0,"VCN")),U,1)
- +23 SET SUBPCN=SUBPCN+PCNBAL
- +24 WRITE !,?8,$EXTRACT(PAT,1,30),?44,$EXTRACT(VCN,1,12),?57,$EXTRACT(PCN,1,12),?70,$JUSTIFY(PCNBAL,10,2)
- +25 IF ($Y+6)>IOSL
- IF $EXTRACT(IOST)="P"
- DO HDR
- +26 IF ($Y+6)>IOSL
- IF $EXTRACT(IOST)="C"
- WRITE *7
- SET DIR(0)="E"
- DO ^DIR
- SET RESP=Y
- DO HDR
- IF RESP=0
- SET FLG("X")=1
- QUIT
- End DoDot:3
- IF FLG("X")
- QUIT
- End DoDot:2
- IF FLG("X")
- QUIT
- +27 WRITE !,?70,"----------",!,"SUBTOTAL",?70,$JUSTIFY(SUBPCN,10,2),!
- +28 SET TOTPCN=TOTPCN+SUBPCN
- End DoDot:1
- IF FLG("X")
- QUIT
- +29 IF FLG("X")=1
- QUIT
- +30 WRITE !!,?70,"----------",!,"TOTAL",?70,$JUSTIFY(TOTPCN,10,2),!
- +31 IF $EXTRACT(IOST)="C"
- WRITE *7
- SET DIR(0)="E"
- DO ^DIR
- IF 'Y
- QUIT
- +32 QUIT
- +33 ;----------------------------------------------------------------------
- HDR WRITE @IOF
- +1 WRITE !,$EXTRACT(TITLE,1,39),?40,$EXTRACT(SITE,1,24),?68,$EXTRACT(DATE,1,12)
- +2 WRITE !!,"INSURER/PATIENT",?44,"VCN",?57,"PCN",?70,"BALANCE"
- +3 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
- +4 QUIT
