- 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 Feb 18, 2025@23:40:01 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 ;