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