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

IVM20P1.m

Go to the documentation of this file.
  1. IVM20P1 ;ALB/CPM - IVM V2.0 POST INIT, SET HL7 PARAMETERS ; 24-JUN-94
  1. ;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
  1. ;
  1. HL7 ; Set up all HL7 parameters
  1. Q:+$G(^DD(301.5,0,"VR"))'<2
  1. D HL7713,HL771,HL770
  1. K IVMAPP,IVMDIEN,IVMMIEN,IVMPRODL,IVMSEG
  1. Q
  1. ;
  1. ;
  1. HL7713 ; Add HL7 segments
  1. W !!,">>> Adding 'Z' segments to HL7 SEGMENT NAME file (#771.3)..."
  1. S IVMFLG=0
  1. F IVMI=1:1 S IVMTXT=$P($T(SEG+IVMI),";;",2) Q:IVMTXT="QUIT" D
  1. .S X=$P(IVMTXT,"^",1) I $O(^HL(771.3,"B",X,0)) Q
  1. .S (DIK,DIC)="^HL(771.3,",DIC(0)="L",DLAYGO=771.3
  1. .K DD,DO,DINUM D FILE^DICN S DA=+Y
  1. .L +^HL(771.3,DA) S ^HL(771.3,DA,0)=IVMTXT D IX1^DIK L -^HL(771.3,DA)
  1. .S IVMFLG=1 W !," >> ",$P(IVMTXT,"^",1)," (",$P(IVMTXT,"^",2),") segment added"
  1. I 'IVMFLG W !?3,"All segments already exist...none added"
  1. HL7713Q K DA,DIC,DIK,DLAYGO,IVMFLG,IVMI,IVMTXT
  1. Q
  1. ;
  1. ;
  1. HL771 ; Update HL7 DHCP application
  1. S (DA,IVMDIEN)=$O(^HL(771,"B","IVM",0))
  1. W !!,">>> ",$S('DA:"Adding",1:"Updating")," HL7 DHCP APPLICATION PARAMETER file entry for IVM..."
  1. I 'DA D I DA<1 G HL771Q
  1. .S DIC="^HL(771,",DIC(0)="L",DLAYGO=771,X="IVM"
  1. .K DD,DO D FILE^DICN S (DA,IVMDIEN)=+Y
  1. S ^HL(771,DA,0)="IVM^a"
  1. S ^HL(771,DA,"EC")="~|\&",^("FS")="^"
  1. S ^HL(771,DA,"MSG",0)="^771.06P^3^3"
  1. S ^HL(771,DA,"MSG",1,0)=$O(^HL(771.2,"B","ORU",0)),^("R")="ORU^IVMPREC2"
  1. S ^HL(771,DA,"MSG",2,0)=$O(^HL(771.2,"B","QRY",0)),^("R")="QRY^IVMPREC"
  1. S ^HL(771,DA,"MSG",3,0)=$O(^HL(771.2,"B","ACK",0)),^("R")="ACK^IVMPREC1"
  1. S ^HL(771,DA,"SEG",0)="^771.05P^15^15"
  1. S ^HL(771,DA,"SEG",1,0)=$$IEN("PID"),^("F")="1,3,5,7,8,11,12,13,14,19"
  1. S ^HL(771,DA,"SEG",2,0)=$$IEN("ZCT"),^("F")="1,2,3,4,5,6,7"
  1. S ^HL(771,DA,"SEG",3,0)=$$IEN("ZDP"),^("F")="1,2,3,4,5,6,7,8,9"
  1. S ^HL(771,DA,"SEG",4,0)=$$IEN("ZEL"),^("F")="1,2,6,7,10,11,13"
  1. S ^HL(771,DA,"SEG",5,0)=$$IEN("ZEM"),^("F")="1,2,3"
  1. S ^HL(771,DA,"SEG",6,0)=$$IEN("ZGD"),^("F")="1,2,3,4,5,6,7,8"
  1. S ^HL(771,DA,"SEG",7,0)=$$IEN("ZIC"),^("F")="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20"
  1. S ^HL(771,DA,"SEG",8,0)=$$IEN("ZMT"),^("F")="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21"
  1. S ^HL(771,DA,"SEG",9,0)=$$IEN("ZPD"),^("F")="1,8,9,11,12,13"
  1. S ^HL(771,DA,"SEG",10,0)=$$IEN("ZTA"),^("F")="1,3,4,5,6,7"
  1. S ^HL(771,DA,"SEG",11,0)=$$IEN("ZIO"),^("F")="1,2,3,4"
  1. S ^HL(771,DA,"SEG",12,0)=$$IEN("ZIR"),^("F")="1,2,3,4,5,6,7,8,9,10"
  1. S ^HL(771,DA,"SEG",13,0)=$$IEN("NTE"),^("F")="1,3"
  1. S ^HL(771,DA,"SEG",14,0)=$$IEN("FT1"),^("F")="1,4,6,7,9,11"
  1. S ^HL(771,DA,"SEG",15,0)=$$IEN("IN1"),^("F")="1,4,5,7,8,9,12,13,15,16,17,28,36"
  1. S ^HL(771,DA,"SEG",16,0)=$$IEN("ZIV"),^("F")="1,2,3,4,5,6,7,8,9,10,11,12"
  1. S DIK="^HL(771," D IX1^DIK
  1. HL771Q K DA,DIC,DIK,DLAYGO,X,Y
  1. Q
  1. ;
  1. ;
  1. HL770 ; Add HL7 non-DHCP app entry
  1. S X=$O(^HL(770,"B","IVM CENTER",0)) I $D(^HL(770,+X,0)) G HL770Q
  1. W !!,">>> Adding HL7 NON-DHCP APPLICATION entry for IVM CENTER..."
  1. S DIC="^HL(770,",DIC(0)="L",DLAYGO=770,X="IVM CENTER"
  1. K DD,DO D FILE^DICN S DA=+Y I DA<1 G HL770Q
  1. S ^HL(770,DA,0)="IVM CENTER^"_+$P($$SITE^VASITE,"^",3)_"^724^245^^^1^"_IVMDIEN_"^^"_IVMMIEN_"^^^^P"
  1. S DIK=DIC D IX1^DIK
  1. HL770Q K DA,DIC,DIK,DLAYGO,X,Y
  1. Q
  1. ;
  1. ;
  1. SEG ; list of segments for HL7 SEGMENT file
  1. ;;ZCT^VA Emergency Contact^1
  1. ;;ZDP^VA Dependent Information^1
  1. ;;ZEL^VA Patient Eligibility^1
  1. ;;ZEM^VA Employment Information^1
  1. ;;ZGD^VA Guardian^1
  1. ;;ZIC^VA Patient Income^1
  1. ;;ZIV^VA IVM Message Processing^1
  1. ;;ZMT^VA Means Test Information^1
  1. ;;ZPD^VA Patient Information^1
  1. ;;ZTA^VA Temporary Address^1
  1. ;;ZIO^VA Patient Care Statistics^1
  1. ;;ZIR^VA Specific Income Information^1
  1. ;;QUIT
  1. ;
  1. ;
  1. IEN(IVMSEG) ; get ien for segment from hl7 segment file
  1. Q $O(^HL(771.3,"B",IVMSEG,0))
  1. ;
  1. ;
  1. BULL ; Send notification to the IVM Center once the facility has installed v2.0.
  1. Q:+$G(^DD(301.5,0,"VR"))'<2
  1. Q:'$G(IVMPROD) ; don't send notice when installing in Test
  1. N DIFROM
  1. W !!,">>> Sending a 'completed installation' notice to the IVM Center... "
  1. S XMSUB="IVM VERSION 2.0 INSTALLATION"
  1. S XMDUZ="IVM PACKAGE"
  1. S XMY("WEATHERLY@IVM.DOMAIN.EXT")="",XMY(DUZ)="",XMY(.5)=""
  1. S XMTEXT="IVMTEXT("
  1. S IVMX=$$SITE^VASITE
  1. S IVMTEXT(1)=" Facility: "_$P(IVMX,"^",2)
  1. S IVMTEXT(2)=" Station Number: "_$P(IVMX,"^",3)
  1. ;
  1. D NOW^%DTC S Y=% D DD^%DT
  1. S IVMTEXT(3)=" Installed IVM Version 2.0 on: "_Y
  1. D ^XMD
  1. K IVMTEXT,IVMX,XMDUZ,XMSUB,XMTEXT,XMY,%
  1. Q