YSCLHLPD ;DSS/PO-CLOZAPINE DATA TRANSMISSION-Messaging-Segment-PID ;19 May 2020 14:13:48
;;5.01;MENTAL HEALTH;**149**;Dec 30, 1994;Build 72
Q
;
; Reference to ^HLOAPI supported by DBIA #4716
;
PID(YSEG,YSCLARR) ; create PID segment
; input: YSCLARR data array to build in HL7 segments from
; output: YSEG segment data to be submitted to HLO
;
N IDA ; ID number array
N RPI ; repetition index
;
S IDA(1)=YSCLARR("PATIENT_CLOZ REG NUM") ;PN
S IDA(2)=YSCLARR("PATIENT_SSN") ;SS
S IDA(3)=YSCLARR("PATIENT_ICN") ;NI ; this field could be as 29 char long our sample are max of 23 char
S IDA(4)=YSCLARR("PATIENT_DFN") ;PI
;
; build segment elements
D SET^HLOAPI(.YSEG,"PID",0)
F RPI=1:1:4 D
. D SET^HLOAPI(.YSEG,IDA(RPI),3,1,1,RPI)
. D SET^HLOAPI(.YSEG,$P("PN^SS^NI^PI",U,RPI),3,5,1,RPI)
;
D SET^HLOAPI(.YSEG,YSCLARR("PATIENT_LAST NAME"),5,1,1,1)
D SET^HLOAPI(.YSEG,YSCLARR("PATIENT_FIRST NAME"),5,2,1,1)
D SET^HLOAPI(.YSEG,"L",5,7,1,1) ; name occ #1
D SET^HLOAPI(.YSEG,YSCLARR("PATIENT_DOB"),7)
D SET^HLOAPI(.YSEG,YSCLARR("PATIENT_SEX"),8)
;
D SET^HLOAPI(.YSEG,YSCLARR("PATIENT_RACE CODE"),10,1,1,1)
D SET^HLOAPI(.YSEG,YSCLARR("PATIENT_RACE"),10,2,1,1)
;
D SET^HLOAPI(.YSEG,"HL70005",10,3)
D SET^HLOAPI(.YSEG,YSCLARR("PATIENT_ZIP"),11,5)
;
D SET^HLOAPI(.YSEG,YSCLARR("PATIENT_ETHNICITY CODE"),22,1,1,1)
D SET^HLOAPI(.YSEG,YSCLARR("PATIENT_ETHNICITY"),22,2,1,1)
D SET^HLOAPI(.YSEG,"HL70189",22,3,1,1)
Q
;
TEST ; Entry point for development / testing
; Select a patient from CLOZAPINE PATIENT LIST who's been authorized
; in the PHARMACY PATIENT File
N DIC,X,Y ; vars used by ^DIC
N DFN,Q,VADM,VAPA ; work vars
N YSCLR,YSCLP ; registration number & DFN for DIC("S") screen
N SEGA ; return segment array
S DIC=603.01,DIC(0)="AEQZ"
S DIC("S")="S YSCLR=$P(^(0),U),YSCLP=$P(^(0),U,2) I $L(YSCLR),YSCLP,$D(^PS(55,""ASAND1"",YSCLR,YSCLP))"
D ^DIC Q:'$D(Y(0)) S DFN=$P(Y(0),"^",2)
D GET^YSCLHLGT(.YSCLARR,DFN)
D PID(.SEGA,.YSCLARR)
;
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)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSCLHLPD 2163 printed Dec 13, 2024@02:13:44 Page 2
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
+2 QUIT
+3 ;
+4 ; Reference to ^HLOAPI supported by DBIA #4716
+5 ;
PID(YSEG,YSCLARR) ; create PID segment
+1 ; input: YSCLARR data array to build in HL7 segments from
+2 ; output: YSEG segment data to be submitted to HLO
+3 ;
+4 ; ID number array
NEW IDA
+5 ; repetition index
NEW RPI
+6 ;
+7 ;PN
SET IDA(1)=YSCLARR("PATIENT_CLOZ REG NUM")
+8 ;SS
SET IDA(2)=YSCLARR("PATIENT_SSN")
+9 ;NI ; this field could be as 29 char long our sample are max of 23 char
SET IDA(3)=YSCLARR("PATIENT_ICN")
+10 ;PI
SET IDA(4)=YSCLARR("PATIENT_DFN")
+11 ;
+12 ; build segment elements
+13 DO SET^HLOAPI(.YSEG,"PID",0)
+14 FOR RPI=1:1:4
Begin DoDot:1
+15 DO SET^HLOAPI(.YSEG,IDA(RPI),3,1,1,RPI)
+16 DO SET^HLOAPI(.YSEG,$PIECE("PN^SS^NI^PI",U,RPI),3,5,1,RPI)
End DoDot:1
+17 ;
+18 DO SET^HLOAPI(.YSEG,YSCLARR("PATIENT_LAST NAME"),5,1,1,1)
+19 DO SET^HLOAPI(.YSEG,YSCLARR("PATIENT_FIRST NAME"),5,2,1,1)
+20 ; name occ #1
DO SET^HLOAPI(.YSEG,"L",5,7,1,1)
+21 DO SET^HLOAPI(.YSEG,YSCLARR("PATIENT_DOB"),7)
+22 DO SET^HLOAPI(.YSEG,YSCLARR("PATIENT_SEX"),8)
+23 ;
+24 DO SET^HLOAPI(.YSEG,YSCLARR("PATIENT_RACE CODE"),10,1,1,1)
+25 DO SET^HLOAPI(.YSEG,YSCLARR("PATIENT_RACE"),10,2,1,1)
+26 ;
+27 DO SET^HLOAPI(.YSEG,"HL70005",10,3)
+28 DO SET^HLOAPI(.YSEG,YSCLARR("PATIENT_ZIP"),11,5)
+29 ;
+30 DO SET^HLOAPI(.YSEG,YSCLARR("PATIENT_ETHNICITY CODE"),22,1,1,1)
+31 DO SET^HLOAPI(.YSEG,YSCLARR("PATIENT_ETHNICITY"),22,2,1,1)
+32 DO SET^HLOAPI(.YSEG,"HL70189",22,3,1,1)
+33 QUIT
+34 ;
TEST ; Entry point for development / testing
+1 ; Select a patient from CLOZAPINE PATIENT LIST who's been authorized
+2 ; in the PHARMACY PATIENT File
+3 ; vars used by ^DIC
NEW DIC,X,Y
+4 ; work vars
NEW DFN,Q,VADM,VAPA
+5 ; registration number & DFN for DIC("S") screen
NEW YSCLR,YSCLP
+6 ; return segment array
NEW SEGA
+7 SET DIC=603.01
SET DIC(0)="AEQZ"
+8 SET DIC("S")="S YSCLR=$P(^(0),U),YSCLP=$P(^(0),U,2) I $L(YSCLR),YSCLP,$D(^PS(55,""ASAND1"",YSCLR,YSCLP))"
+9 DO ^DIC
if '$DATA(Y(0))
QUIT
SET DFN=$PIECE(Y(0),"^",2)
+10 DO GET^YSCLHLGT(.YSCLARR,DFN)
+11 DO PID(.SEGA,.YSCLARR)
+12 ;
+13 WRITE !
SET X=""
SET Q=$CHAR(34)
FOR
SET X=$ORDER(YSCLARR(X))
if X=""
QUIT
SET Y=YSCLARR(X)
WRITE !,$NAME(YSCLARR(X))_"="_$SELECT(Y=+Y:Y,1:Q_Y_Q)
+14 ;
