Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMERCLP

AMERCLP.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. EN(DFN)  ; EP FROM AMERBSDU TO ALLOW PARAMATER TO BE PASSED IN CORRECT NAMESPACE
  1.  N X
  1.  D AMER
  1.  Q
  1. AMER  ;
  1.  ; Users would like to choose how many copies
  1.  N DIR,Y,AMERCOPY
  1.  S (DIR("B"),AMERCOPY)=4
  1.  S DIR("?")="Enter the number of labels to print"
  1.  ;S DIR("?",1)="Enter up to 10 labels to print"
  1.  S DIR("?",1)="Enter up to 50 labels to print"
  1.  ;S DIR(0)="N^1:10:0",DIR("A")="Enter number of labels to print"
  1.  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
  1.  D ^DIR
  1.  S:+Y'=-1 AMERCOPY=+Y
  1.  I Y=0 G START ; IHS/OIT/GIS 07/12/2011 ; PATCH 3
  1.  K DIR,Y
  1. DEV  ;
  1.  S %ZIS("A")="LABEL PRINTER: "
  1.  ;S %ZIS("B")="LER" - IHS/OIT/SCR - 10/15/08 - REMOVE HARD CODED PRINTER
  1.  S %ZIS("B")=$P($G(^AMER(2.5,DUZ(2),0)),"^",2)
  1.  D ^%ZIS
  1.  I POP D HOME^%ZIS Q
  1. START ;
  1.  U IO
  1.  ;
  1.  S AGCHART="00000"_$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2)
  1.  S AGCHART=$E(AGCHART,$L(AGCHART)-5,$L(AGCHART))
  1.  S AGSEX=$P(^DPT(DFN,0),U,2)   ;sex  ;chart #
  1.  S AGNAME=$E($P(^DPT(DFN,0),U),1,20)    ;name
  1.  S AGDOB=$P(^DPT(DFN,0),U,3)  ;dob
  1.  S AGCOM=$P($G(^AUPNPAT(DFN,11)),U,18)  ;current community
  1.  ;F AG=1:1:COPY D
  1.  F AG=1:1:AMERCOPY D
  1.  .W ?5,$E(AGCHART,1,2)_"-"_$E(AGCHART,3,4)_"-"_$E(AGCHART,5,6)
  1.  .W ?20,AGSEX,!,?5,AGNAME
  1.  .W !,?5,$E(AGDOB,4,5)_"/"_$E(AGDOB,6,7)_"/"_$E(AGDOB,2,3),?15,AGCOM
  1.  .;AMER*3.0*6;Removed insurance display
  1.  .;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:"")
  1.  .;AMER*3.0*7;Added extra line feed back in
  1.  .;W !!!
  1.  .W !!!!
  1.  ;
  1.  ;AMER*3.0*5
  1.  D LOG^AMERBUSA("P","P","AMERCLP","AMER: Printed ER Labels",DFN)
  1.  ; 
  1. END K AG,AGNAME,AGCHART,AGSEX,AGDOB,AGCOM,DFN
  1.  D ^%ZISC
  1.  Q
  1. PRVI() ; -- private insurance
  1.  Q $O(^AUPNPRVT("B",DFN,0))
  1.  ;
  1. PRVM() ; -- private insurance eligible multiple ien
  1.  Q $O(^AUPNPRVT(+$$PRVI,11,DT),-1)
  1.  ;
  1. PRVE() ; -- private insurance eligible end date
  1.  Q $P($G(^AUPNPRVT(+$$PRVI,11,+$$PRVM,0)),U,7)
  1.  ;
  1. PRVX() ; -- private insurance eligible
  1.  Q $S($$PRVE>DT:1,($$PRVM)&($$PRVE=""):1,1:"PI")
  1.  ;
  1. MCDC() ; -- medicaid eligibility code
  1.  Q $P($G(^AUPNMCD(+$$MCDI,11,+$$MCDM,0)),U,3)
  1.  ;
  1. MCDN() ; -- medicaid eligibility number
  1.  Q $P($G(^AUPNMCD(+$$MCDI,0)),U,3)
  1.  ;
  1. MCDI() ; -- medicaid eligible ien
  1.  Q $O(^AUPNMCD("B",DFN,0))
  1.  ;
  1. MCDM() ; -- medicaid eligible multiple ien
  1.  Q $O(^AUPNMCD(+$$MCDI,11,DT),-1)
  1.  ;
  1. MCDE() ; -- medicaid eligible end date
  1.  Q $P($G(^AUPNMCD(+$$MCDI,11,+$$MCDM,0)),U,2)
  1.  ;
  1. MCD() ; -- medicaid eligible
  1.  S MCDE=$$MCDE Q $S($$MCDE>DT:1,1:"MCD")
  1.  ;
  1. MCRI() ; -- medicare eligible ien
  1.  Q $O(^AUPNMCR("B",DFN,0))
  1.  ;
  1. MCRM() ; -- medicare eligible multiple ien
  1.  Q $O(^AUPNMCR(+$$MCRI,11,DT),-1)
  1.  ;
  1. MCRE() ; -- medicare eligible end date
  1.  Q $P($G(^AUPNMCR(+$$MCRI,11,+$$MCRM,0)),U,2)
  1.  ;
  1. MCRB() ; -- medicare eligible eligibility
  1.  Q $P($G(^AUPNMCR(+$$MCRI,11,+$$MCRM,0)),U,3)
  1.  ;
  1. MCR() ; -- medicare eligible
  1.  Q $S($$MCRE>DT:1,$$MCRB="B":1,($$MCRM&'$$MCRE):1,1:"MCR")