- PSXRTR ;BIR/BAB,WPB,PWC-Transmit Data to CMOP Host System ;14 Dec 2001
- ;;2.0;CMOP;**18,23,27,31,28,41,51**;11 Apr 97
- ;Reference to ^DIC(4.2 supported by DBIA #1966
- ;Reference to ^PS(59 supported by DBIA #1976
- ;Reference to File #200 supported by DBIA #10060
- ;Requires PSXHDR,PSXORD (A B C D) arrays
- Q
- EN ;Entry point for data transmission, load mailman message and send
- S PSXJOB=1,PSXRTRN=0 K ERR
- I $E(IOST)="C" W !,"EN^PSXRTR DIV: ",PSOSITE," ",+$G(PSXBAT)
- I (($G(PSXBAT)="")!('$D(^PSX(550.1,"C",PSXBAT)))) G EXIT
- S (PSXMSG,PSXMFLAG,PSXEND,PSXSTART)=0
- F S PSXMSG=$O(^PSX(550.1,"C",PSXBAT,PSXMSG)) Q:PSXMSG'>0 S PSXEND=PSXMSG S:PSXSTART=0 PSXSTART=PSXMSG
- S PSXSITE=$P($G(PSXSYS),U,3),PSXSENDR=$$GET1^DIQ(200,DUZ,.01),SITENUM=$P($G(PSXSYS),U,2),PSXDIV=$P($G(^PS(59,+PSOSITE,0)),U,1),XSITE=$P($G(^PS(59,+PSOSITE,0)),U,6)
- S PSXHDR=PSXSITE_U_+PSXSYS_U_SITENUM_U_PSXTDT_U_PSXSENDR_U_PSXSTART_U_PSXEND_U_PSXDIV_U_XSITE,PSXREF=SITENUM_"-"_$$GET1^DIQ(550.2,PSXBAT,.01)
- N DOMAIN,LCNT,XMDUZ,XMSUB,XMZ,ORD
- S (LCNT,PSXMSGCT,PSXRXCT)=0
- S X=$$KSP^XUPARAM("INST"),DIC="4",DIC(0)="XMZO" D ^DIC S SITEX=$P(Y,"^",2) K DIC,X,Y
- S XMSUB="CMOP"_$S($G(PSXCS)=1:" Controlled Substances",1:"")_" Transmission from "_SITEX,XMDUZ=.5
- XMZ D XMZ^XMA2
- I XMZ'>0 G XMZ
- K SITEX
- HDR ;Gather data from header, load NTE1 - NTE5 into mailmessage from PSXORD( array
- S ORD="$$XMIT"_U_$$GET1^DIQ(550.2,PSXBAT,.01)_U_PSXHDR D TXT
- S ORD=$G(PSXORD("A")) D TXT
- ;If not any data in the refill/nonrefill/copay instructions set
- ;set array equal to NTE...+3 spaces
- S:$G(PSXORD("B",1))="" PSXORD("B",1)="NTE|2|| "
- S:$G(PSXORD("C",1))="" PSXORD("C",1)="NTE|3|| "
- S:$G(PSXORD("D",1))="" PSXORD("D",1)="NTE|4|| "
- F ZZ="B","C","D" S Z=0 F S Z=$O(PSXORD(ZZ,Z)) Q:Z'>0 S ORD=$G(PSXORD(ZZ,Z)) D TXT
- ;Gather data for individual patient orders
- LOCK ;
- D NOW^%DTC S DTTM=%,(MSG,ZCNT)=0
- ; load patients' 550.1 "T" nodes into the mail message
- F S MSG=$O(^PSX(550.1,"C",PSXBAT,MSG)) Q:MSG="" S PSXMSGCT=PSXMSGCT+1,LNTX=+$P(^PSX(550.1,MSG,"T",0),U,4) D
- .S ORD="$MSG^"_+$G(^PSX(550.1,MSG,0))_U_LNTX D TXT
- .F PSX=1:1:LNTX I $G(^PSX(550.1,MSG,"T",PSX,0))]"" S ORD=$G(^(0)) S:$E(ORD,1,7)="ORC|NW|" PSXRXCT=PSXRXCT+1 D TXT
- .K DA,DIE,DR S DA=MSG L +^PSX(550.1,DA)
- .S DIE="^PSX(550.1,",DR="1///2;5////"_DTTM_";3////"_PSXBAT
- .D ^DIE L -^PSX(550.1,DA) K DA,DIE,DR ;update msgs in 550.1
- S ORD="$$ENDXMIT^"_U_PSXFAC_U_PSXBAT_U_PSXMSGCT_U_PSXRXCT D TXT K ORD
- S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_U_LCNT_U_DT,XMDUN="CMOP Manager"
- S XMDUZ=.5
- S RECV=$P($G(^PSX(550,+PSXSYS,0)),U,4),DOMAIN="@"_$$GET1^DIQ(4.2,RECV,.01)
- ;code to divert patient transmissions for testing
- I '$D(^XTMP("PSXDIVERTCMOP")) S XMY("S.PSXX CMOP SERVER"_DOMAIN)="" I 1 ;****TESTING
- E S XX=^XTMP("PSXDIVERTCMOP",1) S XMY(XX)="" H 1 ;****TESTING S.PSXX
- D ENT1^XMD
- D XMIT
- S PSXFLAG=1 D EN^PSXNOTE
- K DIE,DA,DR,BAT,PSX,PSXORD,MSG,LNTX,LCNT,DOMAIN,RECV,SITENUM,Z,ZZ,XMDUN,XMDUZ,XMSUB,XMY,XMZ,PSXDIV,XSITE
- Q
- XMIT ;Update 550.2 # of ORDs, RXs; rxS IN 52, 52.5: 550.2 to Transmitted
- ;Update 550 with batch
- N PSXTRDTM D NOW^%DTC S PSXTRDTM=%
- L +^PSX(550.2,PSXBAT):600 I '$T S XQAMSG="CMOP Transmission file in use. Entry for trans "_PSXBAT_" not complete. Contact IRM." D GRP1^PSXNOTE,SETUP^XQALERT K XQAMSG,XQA Q
- S DA=PSXBAT,DIE="^PSX(550.2,",DR="1////2;11////"_PSXSTART_";12////"_PSXEND_";13////"_PSXMSGCT_";14////"_PSXRXCT_";5////"_PSXTRDTM
- D ^DIE K DA,DIE,DR
- L -^PSX(550.2,PSXBAT)
- S PSXMFLAG=1
- D ^PSXRXU ; update RXs in 52 52.5
- L +^PSX(550,+PSXSYS):600 Q:'$T
- S DA=+PSXSYS,DIE="^PSX(550,",DR="6////"_PSXBAT D ^DIE K DIE,DA,DR
- L -^PSX(550,+PSXSYS)
- Q
- TXT ;
- I $G(ORD)]"" S LCNT=LCNT+1,^XMB(3.9,XMZ,2,LCNT,0)=ORD
- Q
- EXIT K %,ERROR,PSXRTRN,PSXJOB,PSXER,PSXHDR,PSXFAC,PSXBAT,PSXEND,PSXMFLAG,PSXMSG,PSXMSGCT,PSXRXCT,PSXSENDR,PSXSITE,PSXTDT,N Q
- Q
- DIVERT ; divert transmissions from CMOP to the user evoking the divert
- W !,"This will divert CMOP Patient transmissions to the user evoking the divert",!,"for one day or until 'D RESET^PSXRTR' is executed.",!
- K DIR S DIR(0)="YO",DIR("B")="N" D ^DIR
- I 'Y W !,"CMOP Patient transmissions >>NOT DIVERTED<<",! Q
- S ^XTMP("PSXDIVERTCMOP",0)=DT_U_DT_U_"Divert CMOP Transmissions"
- S ^XTMP("PSXDIVERTCMOP",1)=DUZ
- W !!,"CMOP Patient transmissions >>DIVERTED<< to ",$$GET1^DIQ(200,DUZ,.01),!!,"Use 'D RESET^PSXRTR' to restore normal CMOP Patient transmissions.",!
- K DIR S DIR(0)="E",DIR("A")="<CR> Continue" D ^DIR
- Q
- RESET ; reset normal CMOP Patient transmissions
- S XX=$D(^XTMP("PSXDIVERTCMOP"))
- S N=$S(XX>0:"HAD BEEN",1:"HAD NOT BEEN")
- W !,"CMOP Patient transmissions >>",N,"<< diverted"
- I XX S XX=^XTMP("PSXDIVERTCMOP",1) W " to ",$$GET1^DIQ(200,XX,.01)
- W ".",!,"CMOP Patient transmissions are set to go to the CMOP.",!
- K ^XTMP("PSXDIVERTCMOP")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXRTR 4841 printed Mar 13, 2025@20:49:44 Page 2
- PSXRTR ;BIR/BAB,WPB,PWC-Transmit Data to CMOP Host System ;14 Dec 2001
- +1 ;;2.0;CMOP;**18,23,27,31,28,41,51**;11 Apr 97
- +2 ;Reference to ^DIC(4.2 supported by DBIA #1966
- +3 ;Reference to ^PS(59 supported by DBIA #1976
- +4 ;Reference to File #200 supported by DBIA #10060
- +5 ;Requires PSXHDR,PSXORD (A B C D) arrays
- +6 QUIT
- EN ;Entry point for data transmission, load mailman message and send
- +1 SET PSXJOB=1
- SET PSXRTRN=0
- KILL ERR
- +2 IF $EXTRACT(IOST)="C"
- WRITE !,"EN^PSXRTR DIV: ",PSOSITE," ",+$GET(PSXBAT)
- +3 IF (($GET(PSXBAT)="")!('$DATA(^PSX(550.1,"C",PSXBAT))))
- GOTO EXIT
- +4 SET (PSXMSG,PSXMFLAG,PSXEND,PSXSTART)=0
- +5 FOR
- SET PSXMSG=$ORDER(^PSX(550.1,"C",PSXBAT,PSXMSG))
- if PSXMSG'>0
- QUIT
- SET PSXEND=PSXMSG
- if PSXSTART=0
- SET PSXSTART=PSXMSG
- +6 SET PSXSITE=$PIECE($GET(PSXSYS),U,3)
- SET PSXSENDR=$$GET1^DIQ(200,DUZ,.01)
- SET SITENUM=$PIECE($GET(PSXSYS),U,2)
- SET PSXDIV=$PIECE($GET(^PS(59,+PSOSITE,0)),U,1)
- SET XSITE=$PIECE($GET(^PS(59,+PSOSITE,0)),U,6)
- +7 SET PSXHDR=PSXSITE_U_+PSXSYS_U_SITENUM_U_PSXTDT_U_PSXSENDR_U_PSXSTART_U_PSXEND_U_PSXDIV_U_XSITE
- SET PSXREF=SITENUM_"-"_$$GET1^DIQ(550.2,PSXBAT,.01)
- +8 NEW DOMAIN,LCNT,XMDUZ,XMSUB,XMZ,ORD
- +9 SET (LCNT,PSXMSGCT,PSXRXCT)=0
- +10 SET X=$$KSP^XUPARAM("INST")
- SET DIC="4"
- SET DIC(0)="XMZO"
- DO ^DIC
- SET SITEX=$PIECE(Y,"^",2)
- KILL DIC,X,Y
- +11 SET XMSUB="CMOP"_$SELECT($GET(PSXCS)=1:" Controlled Substances",1:"")_" Transmission from "_SITEX
- SET XMDUZ=.5
- XMZ DO XMZ^XMA2
- +1 IF XMZ'>0
- GOTO XMZ
- +2 KILL SITEX
- HDR ;Gather data from header, load NTE1 - NTE5 into mailmessage from PSXORD( array
- +1 SET ORD="$$XMIT"_U_$$GET1^DIQ(550.2,PSXBAT,.01)_U_PSXHDR
- DO TXT
- +2 SET ORD=$GET(PSXORD("A"))
- DO TXT
- +3 ;If not any data in the refill/nonrefill/copay instructions set
- +4 ;set array equal to NTE...+3 spaces
- +5 if $GET(PSXORD("B",1))=""
- SET PSXORD("B",1)="NTE|2|| "
- +6 if $GET(PSXORD("C",1))=""
- SET PSXORD("C",1)="NTE|3|| "
- +7 if $GET(PSXORD("D",1))=""
- SET PSXORD("D",1)="NTE|4|| "
- +8 FOR ZZ="B","C","D"
- SET Z=0
- FOR
- SET Z=$ORDER(PSXORD(ZZ,Z))
- if Z'>0
- QUIT
- SET ORD=$GET(PSXORD(ZZ,Z))
- DO TXT
- +9 ;Gather data for individual patient orders
- LOCK ;
- +1 DO NOW^%DTC
- SET DTTM=%
- SET (MSG,ZCNT)=0
- +2 ; load patients' 550.1 "T" nodes into the mail message
- +3 FOR
- SET MSG=$ORDER(^PSX(550.1,"C",PSXBAT,MSG))
- if MSG=""
- QUIT
- SET PSXMSGCT=PSXMSGCT+1
- SET LNTX=+$PIECE(^PSX(550.1,MSG,"T",0),U,4)
- Begin DoDot:1
- +4 SET ORD="$MSG^"_+$GET(^PSX(550.1,MSG,0))_U_LNTX
- DO TXT
- +5 FOR PSX=1:1:LNTX
- IF $GET(^PSX(550.1,MSG,"T",PSX,0))]""
- SET ORD=$GET(^(0))
- if $EXTRACT(ORD,1,7)="ORC|NW|"
- SET PSXRXCT=PSXRXCT+1
- DO TXT
- +6 KILL DA,DIE,DR
- SET DA=MSG
- LOCK +^PSX(550.1,DA)
- +7 SET DIE="^PSX(550.1,"
- SET DR="1///2;5////"_DTTM_";3////"_PSXBAT
- +8 ;update msgs in 550.1
- DO ^DIE
- LOCK -^PSX(550.1,DA)
- KILL DA,DIE,DR
- End DoDot:1
- +9 SET ORD="$$ENDXMIT^"_U_PSXFAC_U_PSXBAT_U_PSXMSGCT_U_PSXRXCT
- DO TXT
- KILL ORD
- +10 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_U_LCNT_U_DT
- SET XMDUN="CMOP Manager"
- +11 SET XMDUZ=.5
- +12 SET RECV=$PIECE($GET(^PSX(550,+PSXSYS,0)),U,4)
- SET DOMAIN="@"_$$GET1^DIQ(4.2,RECV,.01)
- +13 ;code to divert patient transmissions for testing
- +14 ;****TESTING
- IF '$DATA(^XTMP("PSXDIVERTCMOP"))
- SET XMY("S.PSXX CMOP SERVER"_DOMAIN)=""
- IF 1
- +15 ;****TESTING S.PSXX
- IF '$TEST
- SET XX=^XTMP("PSXDIVERTCMOP",1)
- SET XMY(XX)=""
- HANG 1
- +16 DO ENT1^XMD
- +17 DO XMIT
- +18 SET PSXFLAG=1
- DO EN^PSXNOTE
- +19 KILL DIE,DA,DR,BAT,PSX,PSXORD,MSG,LNTX,LCNT,DOMAIN,RECV,SITENUM,Z,ZZ,XMDUN,XMDUZ,XMSUB,XMY,XMZ,PSXDIV,XSITE
- +20 QUIT
- XMIT ;Update 550.2 # of ORDs, RXs; rxS IN 52, 52.5: 550.2 to Transmitted
- +1 ;Update 550 with batch
- +2 NEW PSXTRDTM
- DO NOW^%DTC
- SET PSXTRDTM=%
- +3 LOCK +^PSX(550.2,PSXBAT):600
- IF '$TEST
- SET XQAMSG="CMOP Transmission file in use. Entry for trans "_PSXBAT_" not complete. Contact IRM."
- DO GRP1^PSXNOTE
- DO SETUP^XQALERT
- KILL XQAMSG,XQA
- QUIT
- +4 SET DA=PSXBAT
- SET DIE="^PSX(550.2,"
- SET DR="1////2;11////"_PSXSTART_";12////"_PSXEND_";13////"_PSXMSGCT_";14////"_PSXRXCT_";5////"_PSXTRDTM
- +5 DO ^DIE
- KILL DA,DIE,DR
- +6 LOCK -^PSX(550.2,PSXBAT)
- +7 SET PSXMFLAG=1
- +8 ; update RXs in 52 52.5
- DO ^PSXRXU
- +9 LOCK +^PSX(550,+PSXSYS):600
- if '$TEST
- QUIT
- +10 SET DA=+PSXSYS
- SET DIE="^PSX(550,"
- SET DR="6////"_PSXBAT
- DO ^DIE
- KILL DIE,DA,DR
- +11 LOCK -^PSX(550,+PSXSYS)
- +12 QUIT
- TXT ;
- +1 IF $GET(ORD)]""
- SET LCNT=LCNT+1
- SET ^XMB(3.9,XMZ,2,LCNT,0)=ORD
- +2 QUIT
- EXIT KILL %,ERROR,PSXRTRN,PSXJOB,PSXER,PSXHDR,PSXFAC,PSXBAT,PSXEND,PSXMFLAG,PSXMSG,PSXMSGCT,PSXRXCT,PSXSENDR,PSXSITE,PSXTDT,N
- QUIT
- +1 QUIT
- DIVERT ; divert transmissions from CMOP to the user evoking the divert
- +1 WRITE !,"This will divert CMOP Patient transmissions to the user evoking the divert",!,"for one day or until 'D RESET^PSXRTR' is executed.",!
- +2 KILL DIR
- SET DIR(0)="YO"
- SET DIR("B")="N"
- DO ^DIR
- +3 IF 'Y
- WRITE !,"CMOP Patient transmissions >>NOT DIVERTED<<",!
- QUIT
- +4 SET ^XTMP("PSXDIVERTCMOP",0)=DT_U_DT_U_"Divert CMOP Transmissions"
- +5 SET ^XTMP("PSXDIVERTCMOP",1)=DUZ
- +6 WRITE !!,"CMOP Patient transmissions >>DIVERTED<< to ",$$GET1^DIQ(200,DUZ,.01),!!,"Use 'D RESET^PSXRTR' to restore normal CMOP Patient transmissions.",!
- +7 KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="<CR> Continue"
- DO ^DIR
- +8 QUIT
- RESET ; reset normal CMOP Patient transmissions
- +1 SET XX=$DATA(^XTMP("PSXDIVERTCMOP"))
- +2 SET N=$SELECT(XX>0:"HAD BEEN",1:"HAD NOT BEEN")
- +3 WRITE !,"CMOP Patient transmissions >>",N,"<< diverted"
- +4 IF XX
- SET XX=^XTMP("PSXDIVERTCMOP",1)
- WRITE " to ",$$GET1^DIQ(200,XX,.01)
- +5 WRITE ".",!,"CMOP Patient transmissions are set to go to the CMOP.",!
- +6 KILL ^XTMP("PSXDIVERTCMOP")
- +7 QUIT
