AMERCLP ; IHS/ANMC/GIS - SELECT PATIENTS & PRINT CHART LABELS ;
;;3.0;ER VISIT SYSTEM;**2,3,5,6,7**;MAR 03, 2009;Build 5
;
EN(DFN) ; EP FROM AMERBSDU TO ALLOW PARAMATER TO BE PASSED IN CORRECT NAMESPACE
N X
D AMER
Q
AMER ;
; Users would like to choose how many copies
N DIR,Y,AMERCOPY
S (DIR("B"),AMERCOPY)=4
S DIR("?")="Enter the number of labels to print"
;S DIR("?",1)="Enter up to 10 labels to print"
S DIR("?",1)="Enter up to 50 labels to print"
;S DIR(0)="N^1:10:0",DIR("A")="Enter number of labels to print"
S DIR(0)="N^0:50:0",DIR("A")="Enter number of labels to print" ;IHS/SCR/OIT 072709 patch 2 ; IHS/OIT/GIS 07/12/2011 ; PATCH 3
D ^DIR
S:+Y'=-1 AMERCOPY=+Y
I Y=0 G START ; IHS/OIT/GIS 07/12/2011 ; PATCH 3
K DIR,Y
DEV ;
S %ZIS("A")="LABEL PRINTER: "
;S %ZIS("B")="LER" - IHS/OIT/SCR - 10/15/08 - REMOVE HARD CODED PRINTER
S %ZIS("B")=$P($G(^AMER(2.5,DUZ(2),0)),"^",2)
D ^%ZIS
I POP D HOME^%ZIS Q
START ;
U IO
;
S AGCHART="00000"_$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2)
S AGCHART=$E(AGCHART,$L(AGCHART)-5,$L(AGCHART))
S AGSEX=$P(^DPT(DFN,0),U,2) ;sex ;chart #
S AGNAME=$E($P(^DPT(DFN,0),U),1,20) ;name
S AGDOB=$P(^DPT(DFN,0),U,3) ;dob
S AGCOM=$P($G(^AUPNPAT(DFN,11)),U,18) ;current community
;F AG=1:1:COPY D
F AG=1:1:AMERCOPY D
.W ?5,$E(AGCHART,1,2)_"-"_$E(AGCHART,3,4)_"-"_$E(AGCHART,5,6)
.W ?20,AGSEX,!,?5,AGNAME
.W !,?5,$E(AGDOB,4,5)_"/"_$E(AGDOB,6,7)_"/"_$E(AGDOB,2,3),?15,AGCOM
.;AMER*3.0*6;Removed insurance display
.;W !,?5,$S(($$MCD=1)&($$MCR=1)&($$PRVX=1):"MCAID/MCARE/PRIV INS",($$MCD=1)&($$PRVX=1):"MCAID/PRIV INS",($$MCR=1)&($$PRVX=1):"MCARE/PRIV INS",($$MCR=1)&($$MCD=1):"MCARE/MCAID",$$MCR=1:"MCARE",$$MCD=1:"MCAID",$$PRVX=1:"PRIV INS",1:"")
.;AMER*3.0*7;Added extra line feed back in
.;W !!!
.W !!!!
;
;AMER*3.0*5
D LOG^AMERBUSA("P","P","AMERCLP","AMER: Printed ER Labels",DFN)
;
END K AG,AGNAME,AGCHART,AGSEX,AGDOB,AGCOM,DFN
D ^%ZISC
Q
PRVI() ; -- private insurance
Q $O(^AUPNPRVT("B",DFN,0))
;
PRVM() ; -- private insurance eligible multiple ien
Q $O(^AUPNPRVT(+$$PRVI,11,DT),-1)
;
PRVE() ; -- private insurance eligible end date
Q $P($G(^AUPNPRVT(+$$PRVI,11,+$$PRVM,0)),U,7)
;
PRVX() ; -- private insurance eligible
Q $S($$PRVE>DT:1,($$PRVM)&($$PRVE=""):1,1:"PI")
;
MCDC() ; -- medicaid eligibility code
Q $P($G(^AUPNMCD(+$$MCDI,11,+$$MCDM,0)),U,3)
;
MCDN() ; -- medicaid eligibility number
Q $P($G(^AUPNMCD(+$$MCDI,0)),U,3)
;
MCDI() ; -- medicaid eligible ien
Q $O(^AUPNMCD("B",DFN,0))
;
MCDM() ; -- medicaid eligible multiple ien
Q $O(^AUPNMCD(+$$MCDI,11,DT),-1)
;
MCDE() ; -- medicaid eligible end date
Q $P($G(^AUPNMCD(+$$MCDI,11,+$$MCDM,0)),U,2)
;
MCD() ; -- medicaid eligible
S MCDE=$$MCDE Q $S($$MCDE>DT:1,1:"MCD")
;
MCRI() ; -- medicare eligible ien
Q $O(^AUPNMCR("B",DFN,0))
;
MCRM() ; -- medicare eligible multiple ien
Q $O(^AUPNMCR(+$$MCRI,11,DT),-1)
;
MCRE() ; -- medicare eligible end date
Q $P($G(^AUPNMCR(+$$MCRI,11,+$$MCRM,0)),U,2)
;
MCRB() ; -- medicare eligible eligibility
Q $P($G(^AUPNMCR(+$$MCRI,11,+$$MCRM,0)),U,3)
;
MCR() ; -- medicare eligible
Q $S($$MCRE>DT:1,$$MCRB="B":1,($$MCRM&'$$MCRE):1,1:"MCR")
AMERCLP ; IHS/ANMC/GIS - SELECT PATIENTS & PRINT CHART LABELS ;
+1 ;;3.0;ER VISIT SYSTEM;**2,3,5,6,7**;MAR 03, 2009;Build 5
+2 ;
EN(DFN) ; EP FROM AMERBSDU TO ALLOW PARAMATER TO BE PASSED IN CORRECT NAMESPACE
+1 NEW X
+2 DO AMER
+3 QUIT
AMER ;
+1 ; Users would like to choose how many copies
+2 NEW DIR,Y,AMERCOPY
+3 SET (DIR("B"),AMERCOPY)=4
+4 SET DIR("?")="Enter the number of labels to print"
+5 ;S DIR("?",1)="Enter up to 10 labels to print"
+6 SET DIR("?",1)="Enter up to 50 labels to print"
+7 ;S DIR(0)="N^1:10:0",DIR("A")="Enter number of labels to print"
+8 ;IHS/SCR/OIT 072709 patch 2 ; IHS/OIT/GIS 07/12/2011 ; PATCH 3
SET DIR(0)="N^0:50:0"
SET DIR("A")="Enter number of labels to print"
+9 DO ^DIR
+10 IF +Y'=-1
SET AMERCOPY=+Y
+11 ; IHS/OIT/GIS 07/12/2011 ; PATCH 3
IF Y=0
GOTO START
+12 KILL DIR,Y
DEV ;
+1 SET %ZIS("A")="LABEL PRINTER: "
+2 ;S %ZIS("B")="LER" - IHS/OIT/SCR - 10/15/08 - REMOVE HARD CODED PRINTER
+3 SET %ZIS("B")=$PIECE($GET(^AMER(2.5,DUZ(2),0)),"^",2)
+4 DO ^%ZIS
+5 IF POP
DO HOME^%ZIS
QUIT
START ;
+1 USE IO
+2 ;
+3 SET AGCHART="00000"_$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2)
+4 SET AGCHART=$EXTRACT(AGCHART,$LENGTH(AGCHART)-5,$LENGTH(AGCHART))
+5 ;sex ;chart #
SET AGSEX=$PIECE(^DPT(DFN,0),U,2)
+6 ;name
SET AGNAME=$EXTRACT($PIECE(^DPT(DFN,0),U),1,20)
+7 ;dob
SET AGDOB=$PIECE(^DPT(DFN,0),U,3)
+8 ;current community
SET AGCOM=$PIECE($GET(^AUPNPAT(DFN,11)),U,18)
+9 ;F AG=1:1:COPY D
+10 FOR AG=1:1:AMERCOPY
Begin DoDot:1
+11 WRITE ?5,$EXTRACT(AGCHART,1,2)_"-"_$EXTRACT(AGCHART,3,4)_"-"_$EXTRACT(AGCHART,5,6)
+12 WRITE ?20,AGSEX,!,?5,AGNAME
+13 WRITE !,?5,$EXTRACT(AGDOB,4,5)_"/"_$EXTRACT(AGDOB,6,7)_"/"_$EXTRACT(AGDOB,2,3),?15,AGCOM
+14 ;AMER*3.0*6;Removed insurance display
+15 ;W !,?5,$S(($$MCD=1)&($$MCR=1)&($$PRVX=1):"MCAID/MCARE/PRIV INS",($$MCD=1)&($$PRVX=1):"MCAID/PRIV INS",($$MCR=1)&($$PRVX=1):"MCARE/PRIV INS",($$MCR=1)&($$MCD=1):"MCARE/MCAID",$$MCR=1:"MCARE",$$MCD=1:"MCAID",$$PRVX=1:"PRIV INS",1:"")
+16 ;AMER*3.0*7;Added extra line feed back in
+17 ;W !!!
+18 WRITE !!!!
End DoDot:1
+19 ;
+20 ;AMER*3.0*5
+21 DO LOG^AMERBUSA("P","P","AMERCLP","AMER: Printed ER Labels",DFN)
+22 ;
END KILL AG,AGNAME,AGCHART,AGSEX,AGDOB,AGCOM,DFN
+1 DO ^%ZISC
+2 QUIT
PRVI() ; -- private insurance
+1 QUIT $ORDER(^AUPNPRVT("B",DFN,0))
+2 ;
PRVM() ; -- private insurance eligible multiple ien
+1 QUIT $ORDER(^AUPNPRVT(+$$PRVI,11,DT),-1)
+2 ;
PRVE() ; -- private insurance eligible end date
+1 QUIT $PIECE($GET(^AUPNPRVT(+$$PRVI,11,+$$PRVM,0)),U,7)
+2 ;
PRVX() ; -- private insurance eligible
+1 QUIT $SELECT($$PRVE>DT:1,($$PRVM)&($$PRVE=""):1,1:"PI")
+2 ;
MCDC() ; -- medicaid eligibility code
+1 QUIT $PIECE($GET(^AUPNMCD(+$$MCDI,11,+$$MCDM,0)),U,3)
+2 ;
MCDN() ; -- medicaid eligibility number
+1 QUIT $PIECE($GET(^AUPNMCD(+$$MCDI,0)),U,3)
+2 ;
MCDI() ; -- medicaid eligible ien
+1 QUIT $ORDER(^AUPNMCD("B",DFN,0))
+2 ;
MCDM() ; -- medicaid eligible multiple ien
+1 QUIT $ORDER(^AUPNMCD(+$$MCDI,11,DT),-1)
+2 ;
MCDE() ; -- medicaid eligible end date
+1 QUIT $PIECE($GET(^AUPNMCD(+$$MCDI,11,+$$MCDM,0)),U,2)
+2 ;
MCD() ; -- medicaid eligible
+1 SET MCDE=$$MCDE
QUIT $SELECT($$MCDE>DT:1,1:"MCD")
+2 ;
MCRI() ; -- medicare eligible ien
+1 QUIT $ORDER(^AUPNMCR("B",DFN,0))
+2 ;
MCRM() ; -- medicare eligible multiple ien
+1 QUIT $ORDER(^AUPNMCR(+$$MCRI,11,DT),-1)
+2 ;
MCRE() ; -- medicare eligible end date
+1 QUIT $PIECE($GET(^AUPNMCR(+$$MCRI,11,+$$MCRM,0)),U,2)
+2 ;
MCRB() ; -- medicare eligible eligibility
+1 QUIT $PIECE($GET(^AUPNMCR(+$$MCRI,11,+$$MCRM,0)),U,3)
+2 ;
MCR() ; -- medicare eligible
+1 QUIT $SELECT($$MCRE>DT:1,$$MCRB="B":1,($$MCRM&'$$MCRE):1,1:"MCR")
