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

YSCLTST9.m

Go to the documentation of this file.
  1. 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
  1. Q
  1. ;
  1. DEMOG ; transmit demographic data to RUCL server
  1. ;
  1. D DT^DICRW K ^TMP($J,"YSFMPTS"),^TMP($J,"YSCLXMSG"),^TMP($J,"YSDFNSENT")
  1. ; YSREC - record to be sent in MailMan message
  1. N X,XMSUB,XMY,YSIEN,YSREC,YSV,YSXMZ
  1. S YSV("ptCount")=0,YSV("siteZipCode")="zip+4"
  1. ; 59,.05 MAILING FRANK ZIP+4 CODE
  1. S X=$$GET1^DIQ(59,1,.05) S:X]"" YSV("siteZipCode")=X
  1. D LIST^DIC(603.01,,".01;1;2;3","I",,,,,,,$NA(^TMP($J,"YSFMPTS"))) ; get snapshot of file
  1. S YSIEN=0 F S YSIEN=$O(^TMP($J,"YSFMPTS","DILIST","ID",YSIEN)) Q:'YSIEN D
  1. . N YSNTRY,DFN
  1. . M YSNTRY=^TMP($J,"YSFMPTS","DILIST","ID",YSIEN)
  1. . S DFN=+$G(YSNTRY(1)),^TMP($J,"YSDFNSENT",DFN)=0 ; set to zero, demographics not sent
  1. . Q:'$L($$GET1^DIQ(55,DFN,53)) ; no CLOZAPINE REGISTRATION NUMBER
  1. . Q:$$GET1^DIQ(55,DFN,56,"I") ; DEMOGRAPHICS SENT, don't retransmit
  1. . N PHYS,VADM,VAPA,VAERR
  1. . D DEM^VADPT,ADD^VADPT
  1. . S YSREC=$G(YSNTRY(.01)) ; 603.01,.01 CLOZAPINE REGISTRATION NUMBER
  1. . S $P(YSREC,U,2)=$E($P(VADM(1),",",2))_$E(VADM(1)) ; initials
  1. . S $P(YSREC,U,3)=$P(VADM(3),U) ; date of birth
  1. . S $P(YSREC,U,4)=$P(VADM(2),U) ; ssn
  1. . S $P(YSREC,U,5)=$P(VADM(5),U) ; sex
  1. . S $P(YSREC,U,6)=VAPA(6) ; patient zip
  1. . S $P(YSREC,U,7)=DT ; today
  1. . S $P(YSREC,U,8)=$E($P($G(VADM(12,1)),U,2),1,32) ; race
  1. . S PHYS=+$$GET1^DIQ(55,DFN,57,"I")
  1. . S $P(YSREC,U,9)=$E($$GET1^DIQ(200,PHYS,.01),1,30) ; physician
  1. . S $P(YSREC,U,10)=$$GET1^DIQ(200,PHYS,53.2) ; dea #
  1. . S $P(YSREC,U,11)=YSV("siteZipCode") ; site zip
  1. . D ADD2TXT^YSCLSERV(YSREC)
  1. . S YSV("ptCount")=YSV("ptCount")+1,^TMP($J,"YSDFNSENT",DFN)=1 ; set to 1, demographics sent
  1. ;
  1. I 'YSV("ptCount") D ADD2TXT^YSCLSERV("0^No Patient data to send.") ; put a zero in front of "^"
  1. D TRANSMIT(.YSXMZ) ; send and get message number
  1. S YSV("1stMsg")=YSXMZ
  1. ;
  1. S DFN=0 F S DFN=$O(^TMP($J,"YSDFNSENT",DFN)) Q:'DFN D:$G(^TMP($J,"YSDFNSENT",DFN)) ; only if sent
  1. . N DA,DIE,DR
  1. . S DIE="^PS(55,",DA=DFN,DR="56///1" D ^DIE ; (#56) DEMOGRAPHICS SENT
  1. ;
  1. D ; 603.03,6 - LAST DEMOGRAPHICS TRANSMISSION
  1. . N DA,DIE,DR
  1. . S DIE="^YSCL(603.03,",DA=1,DR="6///"_$$NOW^XLFDT D ^DIE
  1. ;
  1. K ^TMP($J,"YSCLXMSG") ; get rid of 1st message text
  1. K XMY
  1. S XMSUB=$S(+$$GET1^DIQ(603.03,1,3):"DEBUG ",1:"")_"Clozapine demographics"
  1. S X=YSV("ptCount")_" record"_$S(YSV("ptCount")=1:" was",1:"s were")
  1. D ADD2TXT^YSCLSERV("Clozapine demographic data was transmitted, "_X_" sent,")
  1. D ADD2TXT^YSCLSERV("in message number "_YSV("1stMsg")_".")
  1. S XMY("G.PSOCLOZ")=""
  1. ;
  1. ; send the 2nd message
  1. D SENDMSG^XMXAPI(DUZ,XMSUB,$NA(^TMP($J,"YSCLXMSG")),.XMY,"",.YSXMZ)
  1. D XTMPZRO^YSCLTST5
  1. ;
  1. K ^TMP($J,"YSFMPTS"),^TMP($J,"YSDFNSENT") ; clean up
  1. Q
  1. ;
  1. TRANSMIT(YSXMZ) ; trasmit demographics, YSXMZ passed by ref.
  1. ; YSCLSUB set in YSCLSERV
  1. N XMDUN,XMY,XMSUB
  1. S YSXMZ=0 ; message number to return
  1. S YSDEBUG=+$$GET1^DIQ(603.03,1,3,"I") ; 603.03,3 DEBUG MODE
  1. S X=$P($$SITE^VASITE,U,3) ; site number
  1. S XMDUN="NCCC LOGGER",XMDUZ=".5",XMSUB=$S(YSDEBUG:"DEBUG ",$G(YSCLSUB)["DEBUG":"DEBUG ",1:"")_X_" NCCC ENROLLER ("_$$NOW^XLFDT_")"
  1. ;
  1. D SETXMY(.XMY)
  1. ; send the message
  1. D SENDMSG^XMXAPI(DUZ,XMSUB,$NA(^TMP($J,"YSCLXMSG")),.XMY,"",.YSXMZ)
  1. ;
  1. K ^TMP($J,"YSCLXMSG")
  1. Q
  1. ;
  1. SETXMY(YSXMY) ; set mail recipients, YSXMY passed by ref.
  1. ;
  1. N RCPNT,YSDEBUG,YSPROD
  1. S YSPROD=+$$GET1^DIQ(8989.3,1,501,"I") ; 8989.3,501 PRODUCTION
  1. S YSDEBUG=+$$GET1^DIQ(603.03,1,3) ; (#3) DEBUG MODE
  1. ;
  1. D:YSPROD ; production account
  1. . S RCPNT=$$GET1^DIQ(603.03,1,9) ; (#9) DEMOGRAPHIC PROD LISTENER
  1. . S:$L(RCPNT) YSXMY(RCPNT)="" Q:'YSDEBUG
  1. . S YSXMY("G.YSCLOZ DEBUG")="" ; local only in debug mode
  1. ;
  1. D:'YSPROD ; test account
  1. . S RCPNT=$$GET1^DIQ(603.03,1,11) ; (#11) DEMOGRAPHIC TEST LISTENER
  1. . S:$L(RCPNT) YSXMY(RCPNT)=""
  1. . S YSXMY("G.YSCLOZ DEBUG")="" ; local always
  1. . S RCPNT=$$FIND1^DIC(19,"","","RUCLDEM") ; local RUCL server?
  1. . S:RCPNT>0 YSXMY("S.RUCLDEM")=""
  1. ;
  1. Q
  1. ;