YSCLTST9 ; HEC/hrubovcak - transmit demographics to Clozapine data server ;8 Nov 2019 15:21:58
;;5.01;MENTAL HEALTH;**154**;Dec 30, 1994;Build 48
Q
;
DEMOG ; transmit demographic data to RUCL server
;
D DT^DICRW K ^TMP($J,"YSFMPTS"),^TMP($J,"YSCLXMSG"),^TMP($J,"YSDFNSENT")
; YSREC - record to be sent in MailMan message
N X,XMSUB,XMY,YSIEN,YSREC,YSV,YSXMZ
S YSV("ptCount")=0,YSV("siteZipCode")="zip+4"
; 59,.05 MAILING FRANK ZIP+4 CODE
S X=$$GET1^DIQ(59,1,.05) S:X]"" YSV("siteZipCode")=X
D LIST^DIC(603.01,,".01;1;2;3","I",,,,,,,$NA(^TMP($J,"YSFMPTS"))) ; get snapshot of file
S YSIEN=0 F S YSIEN=$O(^TMP($J,"YSFMPTS","DILIST","ID",YSIEN)) Q:'YSIEN D
. N YSNTRY,DFN
. M YSNTRY=^TMP($J,"YSFMPTS","DILIST","ID",YSIEN)
. S DFN=+$G(YSNTRY(1)),^TMP($J,"YSDFNSENT",DFN)=0 ; set to zero, demographics not sent
. Q:'$L($$GET1^DIQ(55,DFN,53)) ; no CLOZAPINE REGISTRATION NUMBER
. Q:$$GET1^DIQ(55,DFN,56,"I") ; DEMOGRAPHICS SENT, don't retransmit
. N PHYS,VADM,VAPA,VAERR
. D DEM^VADPT,ADD^VADPT
. S YSREC=$G(YSNTRY(.01)) ; 603.01,.01 CLOZAPINE REGISTRATION NUMBER
. S $P(YSREC,U,2)=$E($P(VADM(1),",",2))_$E(VADM(1)) ; initials
. S $P(YSREC,U,3)=$P(VADM(3),U) ; date of birth
. S $P(YSREC,U,4)=$P(VADM(2),U) ; ssn
. S $P(YSREC,U,5)=$P(VADM(5),U) ; sex
. S $P(YSREC,U,6)=VAPA(6) ; patient zip
. S $P(YSREC,U,7)=DT ; today
. S $P(YSREC,U,8)=$E($P($G(VADM(12,1)),U,2),1,32) ; race
. S PHYS=+$$GET1^DIQ(55,DFN,57,"I")
. S $P(YSREC,U,9)=$E($$GET1^DIQ(200,PHYS,.01),1,30) ; physician
. S $P(YSREC,U,10)=$$GET1^DIQ(200,PHYS,53.2) ; dea #
. S $P(YSREC,U,11)=YSV("siteZipCode") ; site zip
. D ADD2TXT^YSCLSERV(YSREC)
. S YSV("ptCount")=YSV("ptCount")+1,^TMP($J,"YSDFNSENT",DFN)=1 ; set to 1, demographics sent
;
I 'YSV("ptCount") D ADD2TXT^YSCLSERV("0^No Patient data to send.") ; put a zero in front of "^"
D TRANSMIT(.YSXMZ) ; send and get message number
S YSV("1stMsg")=YSXMZ
;
S DFN=0 F S DFN=$O(^TMP($J,"YSDFNSENT",DFN)) Q:'DFN D:$G(^TMP($J,"YSDFNSENT",DFN)) ; only if sent
. N DA,DIE,DR
. S DIE="^PS(55,",DA=DFN,DR="56///1" D ^DIE ; (#56) DEMOGRAPHICS SENT
;
D ; 603.03,6 - LAST DEMOGRAPHICS TRANSMISSION
. N DA,DIE,DR
. S DIE="^YSCL(603.03,",DA=1,DR="6///"_$$NOW^XLFDT D ^DIE
;
K ^TMP($J,"YSCLXMSG") ; get rid of 1st message text
K XMY
S XMSUB=$S(+$$GET1^DIQ(603.03,1,3):"DEBUG ",1:"")_"Clozapine demographics"
S X=YSV("ptCount")_" record"_$S(YSV("ptCount")=1:" was",1:"s were")
D ADD2TXT^YSCLSERV("Clozapine demographic data was transmitted, "_X_" sent,")
D ADD2TXT^YSCLSERV("in message number "_YSV("1stMsg")_".")
S XMY("G.PSOCLOZ")=""
;
; send the 2nd message
D SENDMSG^XMXAPI(DUZ,XMSUB,$NA(^TMP($J,"YSCLXMSG")),.XMY,"",.YSXMZ)
D XTMPZRO^YSCLTST5
;
K ^TMP($J,"YSFMPTS"),^TMP($J,"YSDFNSENT") ; clean up
Q
;
TRANSMIT(YSXMZ) ; trasmit demographics, YSXMZ passed by ref.
; YSCLSUB set in YSCLSERV
N XMDUN,XMY,XMSUB
S YSXMZ=0 ; message number to return
S YSDEBUG=+$$GET1^DIQ(603.03,1,3,"I") ; 603.03,3 DEBUG MODE
S X=$P($$SITE^VASITE,U,3) ; site number
S XMDUN="NCCC LOGGER",XMDUZ=".5",XMSUB=$S(YSDEBUG:"DEBUG ",$G(YSCLSUB)["DEBUG":"DEBUG ",1:"")_X_" NCCC ENROLLER ("_$$NOW^XLFDT_")"
;
D SETXMY(.XMY)
; send the message
D SENDMSG^XMXAPI(DUZ,XMSUB,$NA(^TMP($J,"YSCLXMSG")),.XMY,"",.YSXMZ)
;
K ^TMP($J,"YSCLXMSG")
Q
;
SETXMY(YSXMY) ; set mail recipients, YSXMY passed by ref.
;
N RCPNT,YSDEBUG,YSPROD
S YSPROD=+$$GET1^DIQ(8989.3,1,501,"I") ; 8989.3,501 PRODUCTION
S YSDEBUG=+$$GET1^DIQ(603.03,1,3) ; (#3) DEBUG MODE
;
D:YSPROD ; production account
. S RCPNT=$$GET1^DIQ(603.03,1,9) ; (#9) DEMOGRAPHIC PROD LISTENER
. S:$L(RCPNT) YSXMY(RCPNT)="" Q:'YSDEBUG
. S YSXMY("G.YSCLOZ DEBUG")="" ; local only in debug mode
;
D:'YSPROD ; test account
. S RCPNT=$$GET1^DIQ(603.03,1,11) ; (#11) DEMOGRAPHIC TEST LISTENER
. S:$L(RCPNT) YSXMY(RCPNT)=""
. S YSXMY("G.YSCLOZ DEBUG")="" ; local always
. S RCPNT=$$FIND1^DIC(19,"","","RUCLDEM") ; local RUCL server?
. S:RCPNT>0 YSXMY("S.RUCLDEM")=""
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSCLTST9 4105 printed Sep 23, 2025@19:50:04 Page 2
YSCLTST9 ; HEC/hrubovcak - transmit demographics to Clozapine data server ;8 Nov 2019 15:21:58
+1 ;;5.01;MENTAL HEALTH;**154**;Dec 30, 1994;Build 48
+2 QUIT
+3 ;
DEMOG ; transmit demographic data to RUCL server
+1 ;
+2 DO DT^DICRW
KILL ^TMP($JOB,"YSFMPTS"),^TMP($JOB,"YSCLXMSG"),^TMP($JOB,"YSDFNSENT")
+3 ; YSREC - record to be sent in MailMan message
+4 NEW X,XMSUB,XMY,YSIEN,YSREC,YSV,YSXMZ
+5 SET YSV("ptCount")=0
SET YSV("siteZipCode")="zip+4"
+6 ; 59,.05 MAILING FRANK ZIP+4 CODE
+7 SET X=$$GET1^DIQ(59,1,.05)
if X]""
SET YSV("siteZipCode")=X
+8 ; get snapshot of file
DO LIST^DIC(603.01,,".01;1;2;3","I",,,,,,,$NAME(^TMP($JOB,"YSFMPTS")))
+9 SET YSIEN=0
FOR
SET YSIEN=$ORDER(^TMP($JOB,"YSFMPTS","DILIST","ID",YSIEN))
if 'YSIEN
QUIT
Begin DoDot:1
+10 NEW YSNTRY,DFN
+11 MERGE YSNTRY=^TMP($JOB,"YSFMPTS","DILIST","ID",YSIEN)
+12 ; set to zero, demographics not sent
SET DFN=+$GET(YSNTRY(1))
SET ^TMP($JOB,"YSDFNSENT",DFN)=0
+13 ; no CLOZAPINE REGISTRATION NUMBER
if '$LENGTH($$GET1^DIQ(55,DFN,53))
QUIT
+14 ; DEMOGRAPHICS SENT, don't retransmit
if $$GET1^DIQ(55,DFN,56,"I")
QUIT
+15 NEW PHYS,VADM,VAPA,VAERR
+16 DO DEM^VADPT
DO ADD^VADPT
+17 ; 603.01,.01 CLOZAPINE REGISTRATION NUMBER
SET YSREC=$GET(YSNTRY(.01))
+18 ; initials
SET $PIECE(YSREC,U,2)=$EXTRACT($PIECE(VADM(1),",",2))_$EXTRACT(VADM(1))
+19 ; date of birth
SET $PIECE(YSREC,U,3)=$PIECE(VADM(3),U)
+20 ; ssn
SET $PIECE(YSREC,U,4)=$PIECE(VADM(2),U)
+21 ; sex
SET $PIECE(YSREC,U,5)=$PIECE(VADM(5),U)
+22 ; patient zip
SET $PIECE(YSREC,U,6)=VAPA(6)
+23 ; today
SET $PIECE(YSREC,U,7)=DT
+24 ; race
SET $PIECE(YSREC,U,8)=$EXTRACT($PIECE($GET(VADM(12,1)),U,2),1,32)
+25 SET PHYS=+$$GET1^DIQ(55,DFN,57,"I")
+26 ; physician
SET $PIECE(YSREC,U,9)=$EXTRACT($$GET1^DIQ(200,PHYS,.01),1,30)
+27 ; dea #
SET $PIECE(YSREC,U,10)=$$GET1^DIQ(200,PHYS,53.2)
+28 ; site zip
SET $PIECE(YSREC,U,11)=YSV("siteZipCode")
+29 DO ADD2TXT^YSCLSERV(YSREC)
+30 ; set to 1, demographics sent
SET YSV("ptCount")=YSV("ptCount")+1
SET ^TMP($JOB,"YSDFNSENT",DFN)=1
End DoDot:1
+31 ;
+32 ; put a zero in front of "^"
IF 'YSV("ptCount")
DO ADD2TXT^YSCLSERV("0^No Patient data to send.")
+33 ; send and get message number
DO TRANSMIT(.YSXMZ)
+34 SET YSV("1stMsg")=YSXMZ
+35 ;
+36 ; only if sent
SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"YSDFNSENT",DFN))
if 'DFN
QUIT
if $GET(^TMP($JOB,"YSDFNSENT",DFN))
Begin DoDot:1
+37 NEW DA,DIE,DR
+38 ; (#56) DEMOGRAPHICS SENT
SET DIE="^PS(55,"
SET DA=DFN
SET DR="56///1"
DO ^DIE
End DoDot:1
+39 ;
+40 ; 603.03,6 - LAST DEMOGRAPHICS TRANSMISSION
Begin DoDot:1
+41 NEW DA,DIE,DR
+42 SET DIE="^YSCL(603.03,"
SET DA=1
SET DR="6///"_$$NOW^XLFDT
DO ^DIE
End DoDot:1
+43 ;
+44 ; get rid of 1st message text
KILL ^TMP($JOB,"YSCLXMSG")
+45 KILL XMY
+46 SET XMSUB=$SELECT(+$$GET1^DIQ(603.03,1,3):"DEBUG ",1:"")_"Clozapine demographics"
+47 SET X=YSV("ptCount")_" record"_$SELECT(YSV("ptCount")=1:" was",1:"s were")
+48 DO ADD2TXT^YSCLSERV("Clozapine demographic data was transmitted, "_X_" sent,")
+49 DO ADD2TXT^YSCLSERV("in message number "_YSV("1stMsg")_".")
+50 SET XMY("G.PSOCLOZ")=""
+51 ;
+52 ; send the 2nd message
+53 DO SENDMSG^XMXAPI(DUZ,XMSUB,$NAME(^TMP($JOB,"YSCLXMSG")),.XMY,"",.YSXMZ)
+54 DO XTMPZRO^YSCLTST5
+55 ;
+56 ; clean up
KILL ^TMP($JOB,"YSFMPTS"),^TMP($JOB,"YSDFNSENT")
+57 QUIT
+58 ;
TRANSMIT(YSXMZ) ; trasmit demographics, YSXMZ passed by ref.
+1 ; YSCLSUB set in YSCLSERV
+2 NEW XMDUN,XMY,XMSUB
+3 ; message number to return
SET YSXMZ=0
+4 ; 603.03,3 DEBUG MODE
SET YSDEBUG=+$$GET1^DIQ(603.03,1,3,"I")
+5 ; site number
SET X=$PIECE($$SITE^VASITE,U,3)
+6 SET XMDUN="NCCC LOGGER"
SET XMDUZ=".5"
SET XMSUB=$SELECT(YSDEBUG:"DEBUG ",$GET(YSCLSUB)["DEBUG":"DEBUG ",1:"")_X_" NCCC ENROLLER ("_$$NOW^XLFDT_")"
+7 ;
+8 DO SETXMY(.XMY)
+9 ; send the message
+10 DO SENDMSG^XMXAPI(DUZ,XMSUB,$NAME(^TMP($JOB,"YSCLXMSG")),.XMY,"",.YSXMZ)
+11 ;
+12 KILL ^TMP($JOB,"YSCLXMSG")
+13 QUIT
+14 ;
SETXMY(YSXMY) ; set mail recipients, YSXMY passed by ref.
+1 ;
+2 NEW RCPNT,YSDEBUG,YSPROD
+3 ; 8989.3,501 PRODUCTION
SET YSPROD=+$$GET1^DIQ(8989.3,1,501,"I")
+4 ; (#3) DEBUG MODE
SET YSDEBUG=+$$GET1^DIQ(603.03,1,3)
+5 ;
+6 ; production account
if YSPROD
Begin DoDot:1
+7 ; (#9) DEMOGRAPHIC PROD LISTENER
SET RCPNT=$$GET1^DIQ(603.03,1,9)
+8 if $LENGTH(RCPNT)
SET YSXMY(RCPNT)=""
if 'YSDEBUG
QUIT
+9 ; local only in debug mode
SET YSXMY("G.YSCLOZ DEBUG")=""
End DoDot:1
+10 ;
+11 ; test account
if 'YSPROD
Begin DoDot:1
+12 ; (#11) DEMOGRAPHIC TEST LISTENER
SET RCPNT=$$GET1^DIQ(603.03,1,11)
+13 if $LENGTH(RCPNT)
SET YSXMY(RCPNT)=""
+14 ; local always
SET YSXMY("G.YSCLOZ DEBUG")=""
+15 ; local RUCL server?
SET RCPNT=$$FIND1^DIC(19,"","","RUCLDEM")
+16 if RCPNT>0
SET YSXMY("S.RUCLDEM")=""
End DoDot:1
+17 ;
+18 QUIT
+19 ;
