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
