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

VSITIPOS.m

Go to the documentation of this file. 
  1. VSITIPOS ;ISL/dee - Visit Post Init ;7/29/96
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**76**;Aug 12, 1996
  1.  ; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect
  1.  ; the incorporation of the module into PCE.  For historical reference,
  1.  ; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
  1.  ; patches.
  1.  ;
  1.  ;;2.0;VISIT TRACKING;;Aug 12, 1996;
  1.  ;IHS/ITSC/LJF 5/30/2003 changed set of visit type from VA to what is set in PCC
  1.  ;             2/06/2004 added code to stuff SITE PART IF VISIT ID field
  1.  ;
  1. EN ;
  1.  ;Run post clean up routine
  1.  S PXNEWCP=$$NEWCP^XPDUTL("VSITIPOS","POST^VSITIPOS")
  1.  Q
  1.  ;
  1. POST ;
  1. DEF ; - add the DEFAULT INSTITUTION to VISIT TRACKING PARAMETERS file
  1.  ;
  1.  N DIC,DLAYGO,DA,DR,DIE,X,DINUM
  1.  D:'$D(^DIC(150.9,1,0))
  1.  . S DIC="^DIC(150.9,",DIC(0)="L",(X,DINUM)=1,DLAYGO="150.9"
  1.  . D FILE^DICN K DINUM,DIC,DLAYGO,DD,DO
  1.  K DA,DR,DIC,DLAYGO,X,DINUM
  1.  ;
  1.  D BMES^XPDUTL("Looking at the VISIT TRACKING PRARMETERS file.")
  1.  D:'+$P($G(^DIC(150.9,1,0)),"^",4)
  1.  . D BMES^XPDUTL("I am going to add an entry to the DEFAULT INSTITUTION field #.04")
  1.  . D MES^XPDUTL(" of the VISIT TRACKING PARAMETERS file.")
  1.  . ;
  1.  . S DR=".04///`"_+$$SITE^VASITE
  1.  . S DA=1,DIE="^DIC(150.9," D ^DIE
  1.  K DA,DR,DIE
  1.  ;
  1.  D:'+$P($G(^DIC(150.9,1,0)),"^",3)
  1.  . D BMES^XPDUTL("I am going to add an entry to the DEFAULT TYPE field #.03")
  1.  . D MES^XPDUTL(" of the VISIT TRACKING PARAMETERS file.")
  1.  . ;
  1.  . ;S DR=".03///V"                                             ;IHS/ITSC/LJF 5/30/2003
  1.  . S DR=".03///"_$$GET1^DIQ(9001001.2,+$$SITE^VASITE,.11,"I")  ;IHS/ITSC/LJF 5/30/2003 use same as in PCC
  1.  . S DA=1,DIE="^DIC(150.9," D ^DIE
  1.  ;
  1.  ;IHS/ITSC/LJF 2/6/2004 fill in SITE PART OF VISIT ID field
  1.  I '$P($G(^DIC(150.9,1,4)),U,2),'$O(^VSIT(150.2,0)) D
  1.  . D BMES^XPDUTL("I am going to add an entry to the SITE PART OF VISIT ID field #402")
  1.  . D MES^XPDUTL(" of the VISIT TRACKING PARAMETERS file.")
  1.  . ;
  1.  . NEW X,DIC,DLAYGO,DA,DR,DIE,Y
  1.  . S X="IHS-"_$$GET1^DIQ(9999999.06,+$$SITE^VASITE,.02)  ;IHS-short name
  1.  . S DIC=150.2,DLAYGO=150.2,DIC(0)="L"
  1.  . S CODE=$$GET1^DIQ(9999999.06,+$$SITE^VASITE,.08) I $L(CODE)<3 S CODE=$E(CODE_"XXX",1,3)
  1.  . S DIC("DR")=".02///"_CODE_";.03///1"
  1.  . D ^DIC
  1.  . ;
  1.  . S DR="402///`"_(+Y),DA=1,DIE="^DIC(150.9," D ^DIE
  1.  ;IHS/ITSC/LJF 2/6/2004 end of new code
  1.  ;
  1.  K DA,DR,DIE
  1.  ;
  1. VSITVID ;
  1.  D BMES^XPDUTL("Set the Visit id in the Visit Tracking Parameters file")
  1.  D MES^XPDUTL("if not already set")
  1.  N VSITNODE
  1.  S VSITNODE=$G(^DIC(150.9,1,4))
  1.  I $P(VSITNODE,"^",1)'?4.NU S $P(^DIC(150.9,1,4),"^",1)="10B0"
  1.  ;
  1. PROTOCOL ;
  1.  N PROTNAME
  1.  S DIE="^ORD(101,"
  1.  S DR="2///@"
  1.  D BMES^XPDUTL("Making sure that these protocols are not disabled.")
  1.  F OFFSET=1:1 SET PROTNAME=$P($T(ENABLE+OFFSET),";;",2) Q:PROTNAME=""  D
  1.  . D MES^XPDUTL("  "_PROTNAME)
  1.  . S DA=$O(^ORD(101,"B",PROTNAME,0))
  1.  . I DA>0 D ^DIE
  1.  Q
  1.  ;
  1. ENABLE ;;
  1.  ;;VSIT PATIENT STATUS
  1.  ;;