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

BSDFORM.m

Go to the documentation of this file. 
  1. BSDFORM ; IHS/ANMC/LJF - PRINTS HS & OTHER FORMS ;  [ 04/08/2004  2:26 PM ]
  1.  ;;5.3;PIMS;**1017,1019**;APR 26, 2002;Build 3
  1.  ;
  1. HS(APCHSPAT,APCHSTYP) ;EP; prints health summary
  1.  ; calls published entry point EN^APCHS
  1.  NEW DFN,SDATE,ORDER,SDCNT,SDSTART,SDSTOP,DIV,SDX,SDREP
  1.  NEW SORT,TERM,CNT,ZZZ
  1.  I $Y>5 W @IOF
  1.  ;
  1.  ;IHS/ITSC/LJF 4/8/2004 if HS set to print but no type defined . . .
  1.  ;I 'APCHSTYP S APCHSTYP=$O(^APCHSCTL("B","ADULT REGULAR",0)) Q:'APCHSTYP  ;IHS/ITSC/LJF 1/2/2004
  1.  I 'APCHSTYP D
  1.  . NEW AGE,X,LIMIT
  1.  . S AGE=$$GET1^DIQ(APCHSPAT,.033)                         ;patient's age
  1.  . S X=$$GET1^DIQ(9009020.1,+$$GET1^DIQ(43,1,12,"I"),.05)  ;min age for adult
  1.  . S LIMIT=$S($G(X):X,1:15)
  1.  . S APCHSTYP=$S(AGE<LIMIT:$O(^APCHSCTL("B","PEDIATRIC",0)),1:$O(^APCHSCTL("B","ADULT REGULAR",0)))
  1.  ;IHS/ITSC/LJF 4/8/2004 end of changes
  1.  ;
  1.  D EN^APCHS
  1.  K AUPNPAT,AUPNDOB,AUPNDOD,AUPNSEX,DIC
  1.  K APCHSPDN,APCHSTAT,APCHSVTP,APCHSNDF,APCHSPRB
  1.  Q
  1.  ;
  1. MP(DFN) ;EP; prints med profile
  1.  NEW SDATE,ORDER,SDCNT,SDSTART,SDSTOP,DIV,SDX,SDREP
  1.  NEW FN,DA,D0,PLS,PSRT,PSLC,PSZCHN,ST,ST0,PSODTCT
  1.  NEW SORT,TERM,CNT,ZZZ
  1.  K ^UTILITY($J)
  1.  NEW HDR S HDR="ISSUE DATE"    ;IHS/ITSC/LJF 1/14/2004 varialbe needed by Phr v7
  1.  S (FN,DA,D0)=DFN,PSRT="DATE",X=""
  1.  S X1=DT,X2=-365 D C^%DTC S PSODTCT=X
  1.  S X="PSOP" X ^%ZOSF("TEST") I $T S PLS="S" U IO D P^PSOP Q
  1.  S X="PSP" X ^%ZOSF("TEST") I $T S PLS=1 U IO D P^PSP
  1.  Q
  1.  ;
  1. AIU(DFN,DIV) ; EP; prints address/insurance update
  1.  NEW SDATE,ORDER,SDCNT,SDSTART,SDSTOP,SDX,SDREP
  1.  NEW BSDX,BSDY,BSDFORM
  1.  NEW SORT,TERM,CNT
  1.  S BSDFORM=1       ;set to prevent device closure in BSDAIU
  1.  S BSDX=$$GET1^DIQ(9000001,DFN,.03,"I")              ;last reg update
  1.  S BSDY=$$GET1^DIQ(9009020.2,$$DIV^BSDU,.08)         ;waiting days
  1.  ;IHS/ITSC/WAR 3/16/04 chg greater than/less than symbol
  1.  ;I $$FMADD^XLFDT(BSDX,BSDY)<DT Q                     ;not time yet
  1.  I $$FMADD^XLFDT(BSDX,BSDY)>DT Q                     ;not time yet
  1.  I $Y>5 W @IOF
  1.  D BEGIN^BSDAIU
  1.  Q
  1.  ;
  1. APRO(SC,DFN,CLDT)  ;EP; calls pharmacy to print action profile
  1.  NEW SDATE,ORDER,SDCNT,SDSTART,SDSTOP,DIV,SDX,SDREP
  1.  NEW FN,DA,D0,PLS,PSRT,PSLC,PSZCHN,ST,ST0,PSODTCT
  1.  NEW BSDATT,BSDATTO,BSDATTC,BSDIOM
  1.  NEW SORT,TERM,CNT,ZZZ
  1.  ;
  1.  ; set variables needed by pharmacy routine
  1.  K ^TMP($J)
  1.  S CLINICX=$P(^SC(+SC,0),U)
  1.  S PAGE=1,D1=CLDT,PSTYPE=1
  1.  S PSDAYS=90,X1=DT,X2=-PSDAYS D C^%DTC S (PSDATE,PSDAY)=X
  1.  S LINE=$$REPEAT^XLFSTR("-",132)
  1.  ;S BSDATT=$P(^DG(40.8,1,"IHS"),U,16)  ;6/28/2002 per Linda (LJF11)
  1.  S BSDATT=$$GET1^DIQ(9009020.2,+$$DIV^BSDU,.13,"I") Q:'BSDATT  ;APRO terminal type;IHS/ANMC/LJF 6/26/2002
  1.  S BSDATTO=$G(^%ZIS(2,BSDATT,2))   ;IHS/ITSC/LJF 1/2/2004 added $G
  1.  S BSDATTC=$G(^%ZIS(2,BSDATT,3))   ;IHS/ITSC/LJF 1/2/2004 added $G
  1.  ;IHS/ITSC/WAR 7/22/03 added next line to identify which pharmacy in ^PS
  1.  ;S PSOSITE=$O(^PS(59,"C",DUZ(2),0))
  1.  S PSOSITE=$O(^PS(59,"D",DUZ(2),0))  ;ihs/cmi/maw 03/01/2012 notified by Chris Saddler that this is now "D" for the station number
  1.  X BSDATTO S BSDIOM=IOM,X=132 X ^%ZOSF("RM")
  1.  D HD^PSOSD2,PAT^PSOSD,RXPAD^PSOSD1:PSTYPE
  1.  W:'$G(PSTYPE)&('$D(^TMP("PSOD",$J))) @IOF
  1.  D ENSTUFF^PSODACT
  1.  X BSDATTC S X=BSDIOM X ^%ZOSF("RM")
  1.  K CLINICX,PAGE,PSTYPE,PSDAYS,PSDATE,PSDAY,PSDT,PSNAME
  1.  K VAPA,VAIN,VAEL,VAERR,PSOBAR2,PSOBAR3,PSOBAR4,PSOPRINT,PSSN,RXCNT
  1.  K LN,LINE,HRCN,FN,ELN,CNT,ADDRFL,VA,PSDOB
  1.  Q