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

BHSWH.m

Go to the documentation of this file. 
  1. BHSWH ;IHS/CIA/MGH - Health Summary for Women's health profile ;17-Mar-2006 10:36;MGH
  1.  ;;1.0;HEALTH SUMMARY COMPONENTS;;March 17, 2006
  1.  ;===================================================================
  1.  ;Rewrite of IHS health summary to use women's health in VA health summary format
  1.  ;This routine writes out the health summary to the screen to be use din the EHR
  1.  ;Taken from APCHS9B3
  1.  ; IHS/TUCSON/LAB - women's health supplement ;  [ 02/19/03  7:37 AM ]
  1.  ;;2.0;IHS RPMS/PCC Health Summary;**3,5,8,9,10**;JUN 24, 1997
  1.  ;
  1.  ;
  1. PROF ; Control Women's health profile retrieval and display;
  1.  N BWD
  1.  S BWD=0
  1.  K ^TMP("BHS",$J)
  1.  Q:$P($G(^DPT(DFN,0)),U,2)="M"
  1.  D EP^BHSWPROF(DFN,BWD)
  1.  Q:'$D(^TMP("BHS",$J))
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  D WHMAIN
  1.  Q
  1. PROF2 ;Do detailed display of patient profile
  1.  N BWD
  1.  S BWD=1
  1.  K ^TMP("BHS",$J)
  1.  Q:$P($G(^DPT(DFN,0)),U,2)="M"
  1.  D EP^BHSWPROF(DFN,BWD)
  1.  Q:'$D(^TMP("BHS",$J))
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  D WHMAIN
  1.  Q
  1. WHMAIN ; Main Display
  1.  N GMORDER,GMHR,GMDT,GMIFN,GMN0,GMW,X,GMTSDAT,HF,LEVEL,PHFC,COMMENT
  1.  N GMICL,GMTAB,GMTSLN,BWACCP,BWACC,Z
  1.  S (BWACCP,Z)=0
  1.  S GMORDER="" F  S GMORDER=$O(^TMP("BHS",$J,GMORDER)) Q:GMORDER=""  D  Q:$D(GMTSQIT)
  1.  . I GMORDER=1 D HEADER
  1.  . I GMORDER=2 D RESULT
  1.  K ^TMP("BHS",$J)
  1.  Q
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)  W "* * * Patient Profile * * *",!
  1.  S GMHR="" F  S GMHR=$O(^TMP("BHS",$J,GMORDER,GMHR)) Q:GMHR=""  D  Q:$D(GMTSQIT)
  1.  . D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  . W $P($G(^TMP("BHS",$J,GMORDER,GMHR)),U,1)
  1.  . W ?50,$P($G(^TMP("BHS",$J,GMORDER,GMHR)),U,2),!
  1.  Q
  1. RESULT ; Display Data from profile
  1.  I BWD=1 D DETAIL Q
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  W !,"DATE",?16,"PROCEDURE",?27,"RESULTS/DIAGNOSIS",?71,"STATUS"
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  W !,"--------",?16,"---------",?27,"----------------------------"
  1.  W ?71,"------"
  1.  S GMIFN="" F  S GMIFN=$O(^TMP("BHS",$J,GMORDER,GMIFN)) Q:GMIFN=""  D  Q:$D(GMTSQIT)
  1.  .S GMN0=$G(^TMP("BHS",$J,GMORDER,GMIFN))
  1.  .D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  .;---> QUIT IF NOT A PROCEDURE (PIECE 1'=1).
  1.  .Q:$P(GMN0,U)'=1
  1.  .W !,$P(GMN0,U,4)                               ;DATE OF PROCEDURE
  1.  .W ?17,$P(GMN0,U,5)                           ;PROCEDURE ABBREVIATION
  1.  .W ?27,$P(GMN0,U,7)                           ;RESULT
  1.  .W ?71,$P(GMN0,U,9)                           ;STATUS
  1.  .S BWACCP=$P(GMN0,U,6)                        ;STORE AS PREVIOUS ACCESS#
  1.  Q
  1. DETAIL ;Display the detailed display
  1.  N I
  1.  S GMIFN="" F  S GMIFN=$O(^TMP("BHS",$J,GMORDER,GMIFN)) Q:GMIFN=""  D  Q:$D(GMTSQIT)
  1.  .S GMN0=$G(^TMP("BHS",$J,GMORDER,GMIFN))
  1.  .D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  .;Copied from BWPROF to display data from profile
  1.  .;---> IF PIECE 1=1 DISPLAY AS A PROCEDURE.
  1.  .I $P(GMN0,U)=1 D  Q
  1.  ..W !,"------------------------------< "
  1.  ..W "PROCEDURE: ",$P(GMN0,U,5)," >"            ;PROCEDURE ABBREVIATION
  1.  ..F I=1:1:(6-$L($P(GMN0,U,5))) W "-"
  1.  ..W "-----------------------------"
  1.  ..W !,$P(GMN0,U,6)                               ;ACCESSION#
  1.  ..;begin Y2K
  1.  ..W ?16,$P(GMN0,U,4)                           ;DATE OF PROCEDURE ;IHS/CMI
  1.  ..;end Y2K
  1.  ..W ?27,"Res/Diag: ",$P(GMN0,U,7)              ;RESULTS/DIAGNOSIS
  1.  ..D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  ..W !,?27,"Provider: ",$E($P(GMN0,U,8),1,14)    ;PROVIDER
  1.  ..W ?62,"Status: ",$P(GMN0,U,9)                ;STATUS
  1.  ..S BWACCP=$P(GMN0,U,6)                        ;STORE AS PREVIOUS ACCESS#
  1.  .;
  1.  .;---> **********************
  1.  .;---> DISPLAY NOTIFICATIONS
  1.  .;---> IF PIECE 1=2 DISPLAY AS A NOTIFICATION.
  1.  .I $P(GMN0,U)=2 D  Q
  1.  ..D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  ..S BWACC=$P(GMN0,U,5)
  1.  ..I BWACC'=Z D
  1.  ...;begin Y2K
  1.  ...W ! W:BWACC["NO ACC#" "-----------------" W ?16 ;IHS/CMI/LAB 17 to 1
  1.  ...;end Y2K
  1.  ...W "-------------< NOTIFICATIONS >---------------------------------"
  1.  ..D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  ..W !
  1.  ..W:BWACC'=BWACCP!(BWACC["NO ACC#") BWACC    ;ACCESSION#
  1.  ..;begin Y2K
  1.  ..W ?16,$P(GMN0,U,4)                            ;DATE OF PROCEDURE;IHS/CMI
  1.  ..;end Y2K
  1.  ..W ?27,$E($P(GMN0,U,6)_": "_$P(GMN0,U,7),1,53)    ;TYPE AND PURPOSE
  1.  ..D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  ..W !,?27,"Outcome: ",$E($P(GMN0,U,8),1,23)      ;OUTCOME OF NOTIFICATION
  1.  ..W ?62,"Status: ",$P(GMN0,U,9)                 ;STATUS
  1.  ..S (BWACCP,Z)=BWACC                         ;STORE AS PREVIOUS ACC#
  1.  ..;
  1.  ..;---> TWO VARIABLES (BWACCP & Z) USED ABOVE: "Z" SAYS "IF THIS NOTIF
  1.  ..;---> ACC# IS NOT THE SAME AS THE LAST ONE, DISPLAY --<NOT>-- BANNER.
  1.  ..;---> "BWACCP" SAYS "IF THIS NOTIF ACC# MATCHES THE LAST PROCEDURE'S
  1.  ..;---> ACC#, DON'T DISPLAY THE ACCESSION#."
  1.  ..;---> BOTH VARIABLES ARE RESET AFTER A FORMFEED, IN ORDER TO DISPLAY
  1.  ..;---> ON THE NEW PAGE.
  1.  .;
  1.  .;---> **********************
  1.  .;---> DISPLAY PAP REGIMENS
  1.  .;---> IF PIECE 1=3 DISPLAY AS A PAP REGIMEN.
  1.  .I $P(GMN0,U)=3 D  Q
  1.  ..D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  ..W !,"------------------------------< PAP REGIMEN CHANGE"
  1.  ..W " >----------------------------"
  1.  ..;begin Y2K
  1.  .. D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  ..W !?9,"Began:" ;IHS/CMI/LAB - 10 to 9 Y2000
  1.  ..W ?16,$P(GMN0,U,4)                           ;DATE OF REGIMEN ENTRY ;IHS
  1.  ..;end Y2K
  1.  ..W ?27,"Regimen: ",$P(GMN0,U,5)               ;PAP REGIMEN
  1.  .;
  1.  .;---> **********************        .;---> DISPLAY PREGNANCIES
  1.  .;---> IF PIECE 1=4 DISPLAY AS A PREGNANCY.
  1.  .I $P(GMN0,U)=4 D  Q
  1.  ..D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  ..W !,"------------------------------< PREGNANCY STATUS"
  1.  ..W " >------------------------------"
  1.  ..;begin Y2K
  1.  ..D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  ..W !?6,"Entered:" ;IHS/CMI/LAB - 8 to 6 patch 5 Y2000
  1.  ..W ?15,$P(GMN0,U,4)                           ;DATE OF PREGNANCY EDIT. ;I
  1.  ..;end Y2K
  1.  ..W ?27,$P(GMN0,U,5)                           ;PREGNANT/NOT
  1.  ..W:$P(GMN0,U,6)]"" ?50,"EDC: ",$P(GMN0,U,6)      ;EDC
  1.  Q
  1. FORMAT ; Format Line
  1.  N DIWR,DIWL,DIWF,X
  1.  S DIWL=3,DIWR=80-(GMICL+GMTAB)
  1.  K ^UTILITY($J,"W")
  1.  S X=COMMENT D ^DIWP
  1.  Q
  1. LINE ; Write Line
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)  W ?13,^UTILITY($J,"W",DIWL,GMTSLN,0),!
  1.  Q