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