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

YSCLHLPD.m

Go to the documentation of this file.
  1. YSCLHLPD ;DSS/PO-CLOZAPINE DATA TRANSMISSION-Messaging-Segment-PID ;19 May 2020 14:13:48
  1. ;;5.01;MENTAL HEALTH;**149**;Dec 30, 1994;Build 72
  1. Q
  1. ;
  1. ; Reference to ^HLOAPI supported by DBIA #4716
  1. ;
  1. PID(YSEG,YSCLARR) ; create PID segment
  1. ; input: YSCLARR data array to build in HL7 segments from
  1. ; output: YSEG segment data to be submitted to HLO
  1. ;
  1. N IDA ; ID number array
  1. N RPI ; repetition index
  1. ;
  1. S IDA(1)=YSCLARR("PATIENT_CLOZ REG NUM") ;PN
  1. S IDA(2)=YSCLARR("PATIENT_SSN") ;SS
  1. S IDA(3)=YSCLARR("PATIENT_ICN") ;NI ; this field could be as 29 char long our sample are max of 23 char
  1. S IDA(4)=YSCLARR("PATIENT_DFN") ;PI
  1. ;
  1. ; build segment elements
  1. D SET^HLOAPI(.YSEG,"PID",0)
  1. F RPI=1:1:4 D
  1. . D SET^HLOAPI(.YSEG,IDA(RPI),3,1,1,RPI)
  1. . D SET^HLOAPI(.YSEG,$P("PN^SS^NI^PI",U,RPI),3,5,1,RPI)
  1. ;
  1. D SET^HLOAPI(.YSEG,YSCLARR("PATIENT_LAST NAME"),5,1,1,1)
  1. D SET^HLOAPI(.YSEG,YSCLARR("PATIENT_FIRST NAME"),5,2,1,1)
  1. D SET^HLOAPI(.YSEG,"L",5,7,1,1) ; name occ #1
  1. D SET^HLOAPI(.YSEG,YSCLARR("PATIENT_DOB"),7)
  1. D SET^HLOAPI(.YSEG,YSCLARR("PATIENT_SEX"),8)
  1. ;
  1. D SET^HLOAPI(.YSEG,YSCLARR("PATIENT_RACE CODE"),10,1,1,1)
  1. D SET^HLOAPI(.YSEG,YSCLARR("PATIENT_RACE"),10,2,1,1)
  1. ;
  1. D SET^HLOAPI(.YSEG,"HL70005",10,3)
  1. D SET^HLOAPI(.YSEG,YSCLARR("PATIENT_ZIP"),11,5)
  1. ;
  1. D SET^HLOAPI(.YSEG,YSCLARR("PATIENT_ETHNICITY CODE"),22,1,1,1)
  1. D SET^HLOAPI(.YSEG,YSCLARR("PATIENT_ETHNICITY"),22,2,1,1)
  1. D SET^HLOAPI(.YSEG,"HL70189",22,3,1,1)
  1. Q
  1. ;
  1. TEST ; Entry point for development / testing
  1. ; Select a patient from CLOZAPINE PATIENT LIST who's been authorized
  1. ; in the PHARMACY PATIENT File
  1. N DIC,X,Y ; vars used by ^DIC
  1. N DFN,Q,VADM,VAPA ; work vars
  1. N YSCLR,YSCLP ; registration number & DFN for DIC("S") screen
  1. N SEGA ; return segment array
  1. S DIC=603.01,DIC(0)="AEQZ"
  1. S DIC("S")="S YSCLR=$P(^(0),U),YSCLP=$P(^(0),U,2) I $L(YSCLR),YSCLP,$D(^PS(55,""ASAND1"",YSCLR,YSCLP))"
  1. D ^DIC Q:'$D(Y(0)) S DFN=$P(Y(0),"^",2)
  1. D GET^YSCLHLGT(.YSCLARR,DFN)
  1. D PID(.SEGA,.YSCLARR)
  1. ;
  1. W ! S X="",Q=$C(34) F S X=$O(YSCLARR(X)) Q:X="" S Y=YSCLARR(X) W !,$NA(YSCLARR(X))_"="_$S(Y=+Y:Y,1:Q_Y_Q)
  1. ;