- ECXTLOCL ;BIR/DMA-Package Extracts for Local Use ; 17 Mar 95 / 1:04 PM
- ;;3.0;DSS EXTRACTS;**8,49**;Dec 22, 1997
- EN ;entry point
- ;Queuing and message sending for package extracts for local use
- ;Input ECPACK printed name of package (e.g. Lab, Prescriptions)
- ; ECRTN in the form of START^ROUTINE
- ; ECGRP name of local mail group to receive summary message
- ; (MUST BE 1 TO 5 UPPER CASE ALPHA - NO SPACES)
- ; ECFILE file number of the local editing file
- ; generates EC23=2nd and 3rd piece of zero node in local editing file
- ; =YYMM of end date^pointer to 727
- ; ECXLOGIC=Fiscal year extract logic to use
- ;
- S EC=$O(^ECX(727.1,"AF",ECFILE,0)),EC=$P($G(^ECX(727.1,EC,0)),U,5) I 'EC G ERROR
- S ECED=$$FMADD^XLFDT(DT,-EC+1),ECSD=$$FMADD^XLFDT(DT,-EC)
- ;look at results for DT-Offset so ECSD=DT-EC
- S ECINST=+$P(^ECX(728,1,0),U) K ECXDIC S DA=ECINST,DIC="^DIC(4,",DIQ(0)="I",DIQ="ECXDIC",DR=".01;99"
- D EN^DIQ1 S ECINST=$G(ECXDIC(4,DA,99,"I")) K DIC,DIQ,DA,DR,ECXDIC
- S ECSDN=$$FMTE^XLFDT(ECSD),ECEDN=$$FMTE^XLFDT(ECED),ECSD1=ECSD-.1
- I '$D(ECXLOGIC) S ECXLOGIC=$$FISCAL^ECXUTL1(ECSD)
- L +^ECX(727,0) S EC=$P(^ECX(727,0),U,3)+1,$P(^(0),U,3,4)=EC_U_EC L -^ECX(727,0)
- S ^ECX(727,EC,0)=EC_U_DT_U_ECPACK_U_ECSD_U_$E(ECED,1,7)
- S ^ECX(727,EC,"HEAD")=ECHEAD
- S ^ECX(727,EC,"FILE")=ECFILE
- S ^ECX(727,EC,"GRP")=ECGRP
- S ^ECX(727,EC,"L")="L"
- S ^ECX(727,EC,"VER")=$G(ECVER)_"^"_ECXLOGIC
- S ^ECX(727,"AC",DT,EC)="",^ECX(727,"AD",ECPACK,EC)=""
- S ECRN=0,EC23=$$ECXYM^ECXUTL(ECED)_U_EC
- D @ECRTN
- S TIME=$P($$HTE^XLFDT($H),":",1,2)
- S $P(^ECX(727,$P(EC23,U,2),0),U,6)=ECRN
- S ECLAST=$O(^ECX(ECFILE,999999999),-1),ECTOTAL=$P(^ECX(ECFILE,0),U,4)+ECRN,$P(^(0),U,3,4)=ECLAST_U_ECTOTAL K ECLAST,ECTOTAL
- ;set piece 3 and 4 of the zero node
- ;
- MSG ; send message to mail group 'DSS-ECGRP'
- S XMSUB=ECINST_" - "_ECPACK_" EXTRACT FOR DSS",XMDUZ="DSS SYSTEM"
- K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
- S ECMSG(1,0)="The LOCAL USE DSS-"_ECPACK_" extract for "_ECSDN_" through "
- S ECMSG(2,0)=ECEDN_" was completed on "_$P(TIME,"@")_" at "_$P(TIME,"@",2)_". "
- S ECMSG(3,0)=" "
- S ECMSG(4,0)="A total of "_ECRN_" records were written."
- S ECMSG(5,0)=" "
- S X=$E(ECXLOGIC,5) S X=$S((X="")!(X=" "):"",1:"revision "_X_" of ")
- S ECMSG(6,0)="The data was extracted using "_X_"fiscal year "_$E(ECXLOGIC,1,4)_" logic."
- S ECMSG(7,0)=" "
- S XMTEXT="ECMSG(" D ^XMD
- Q
- ;
- Q
- ERROR ;local extract not properly setup
- S EC(1)="The local "_ECPACK_" extract was not properly set up",EC(2)="Please review settings in file 727.1 and requeue this extract"
- K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))="",XMTEXT="EC(",XMSUB="Local extract not properly setup",XMDUZ="DSS SYSTEM" D ^XMD
- S ZTREQ="@" Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXTLOCL 2818 printed Feb 18, 2025@23:20:27 Page 2
- ECXTLOCL ;BIR/DMA-Package Extracts for Local Use ; 17 Mar 95 / 1:04 PM
- +1 ;;3.0;DSS EXTRACTS;**8,49**;Dec 22, 1997
- EN ;entry point
- +1 ;Queuing and message sending for package extracts for local use
- +2 ;Input ECPACK printed name of package (e.g. Lab, Prescriptions)
- +3 ; ECRTN in the form of START^ROUTINE
- +4 ; ECGRP name of local mail group to receive summary message
- +5 ; (MUST BE 1 TO 5 UPPER CASE ALPHA - NO SPACES)
- +6 ; ECFILE file number of the local editing file
- +7 ; generates EC23=2nd and 3rd piece of zero node in local editing file
- +8 ; =YYMM of end date^pointer to 727
- +9 ; ECXLOGIC=Fiscal year extract logic to use
- +10 ;
- +11 SET EC=$ORDER(^ECX(727.1,"AF",ECFILE,0))
- SET EC=$PIECE($GET(^ECX(727.1,EC,0)),U,5)
- IF 'EC
- GOTO ERROR
- +12 SET ECED=$$FMADD^XLFDT(DT,-EC+1)
- SET ECSD=$$FMADD^XLFDT(DT,-EC)
- +13 ;look at results for DT-Offset so ECSD=DT-EC
- +14 SET ECINST=+$PIECE(^ECX(728,1,0),U)
- KILL ECXDIC
- SET DA=ECINST
- SET DIC="^DIC(4,"
- SET DIQ(0)="I"
- SET DIQ="ECXDIC"
- SET DR=".01;99"
- +15 DO EN^DIQ1
- SET ECINST=$GET(ECXDIC(4,DA,99,"I"))
- KILL DIC,DIQ,DA,DR,ECXDIC
- +16 SET ECSDN=$$FMTE^XLFDT(ECSD)
- SET ECEDN=$$FMTE^XLFDT(ECED)
- SET ECSD1=ECSD-.1
- +17 IF '$DATA(ECXLOGIC)
- SET ECXLOGIC=$$FISCAL^ECXUTL1(ECSD)
- +18 LOCK +^ECX(727,0)
- SET EC=$PIECE(^ECX(727,0),U,3)+1
- SET $PIECE(^(0),U,3,4)=EC_U_EC
- LOCK -^ECX(727,0)
- +19 SET ^ECX(727,EC,0)=EC_U_DT_U_ECPACK_U_ECSD_U_$EXTRACT(ECED,1,7)
- +20 SET ^ECX(727,EC,"HEAD")=ECHEAD
- +21 SET ^ECX(727,EC,"FILE")=ECFILE
- +22 SET ^ECX(727,EC,"GRP")=ECGRP
- +23 SET ^ECX(727,EC,"L")="L"
- +24 SET ^ECX(727,EC,"VER")=$GET(ECVER)_"^"_ECXLOGIC
- +25 SET ^ECX(727,"AC",DT,EC)=""
- SET ^ECX(727,"AD",ECPACK,EC)=""
- +26 SET ECRN=0
- SET EC23=$$ECXYM^ECXUTL(ECED)_U_EC
- +1 DO @ECRTN
- +2 SET TIME=$PIECE($$HTE^XLFDT($HOROLOG),":",1,2)
- +3 SET $PIECE(^ECX(727,$PIECE(EC23,U,2),0),U,6)=ECRN
- +4 SET ECLAST=$ORDER(^ECX(ECFILE,999999999),-1)
- SET ECTOTAL=$PIECE(^ECX(ECFILE,0),U,4)+ECRN
- SET $PIECE(^(0),U,3,4)=ECLAST_U_ECTOTAL
- KILL ECLAST,ECTOTAL
- +5 ;set piece 3 and 4 of the zero node
- +6 ;
- MSG ; send message to mail group 'DSS-ECGRP'
- +1 SET XMSUB=ECINST_" - "_ECPACK_" EXTRACT FOR DSS"
- SET XMDUZ="DSS SYSTEM"
- +2 KILL XMY
- SET XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
- +3 SET ECMSG(1,0)="The LOCAL USE DSS-"_ECPACK_" extract for "_ECSDN_" through "
- +4 SET ECMSG(2,0)=ECEDN_" was completed on "_$PIECE(TIME,"@")_" at "_$PIECE(TIME,"@",2)_". "
- +5 SET ECMSG(3,0)=" "
- +6 SET ECMSG(4,0)="A total of "_ECRN_" records were written."
- +7 SET ECMSG(5,0)=" "
- +8 SET X=$EXTRACT(ECXLOGIC,5)
- SET X=$SELECT((X="")!(X=" "):"",1:"revision "_X_" of ")
- +9 SET ECMSG(6,0)="The data was extracted using "_X_"fiscal year "_$EXTRACT(ECXLOGIC,1,4)_" logic."
- +10 SET ECMSG(7,0)=" "
- +11 SET XMTEXT="ECMSG("
- DO ^XMD
- +12 QUIT
- +13 ;
- +14 QUIT
- ERROR ;local extract not properly setup
- +1 SET EC(1)="The local "_ECPACK_" extract was not properly set up"
- SET EC(2)="Please review settings in file 727.1 and requeue this extract"
- +2 KILL XMY
- SET XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
- SET XMTEXT="EC("
- SET XMSUB="Local extract not properly setup"
- SET XMDUZ="DSS SYSTEM"
- DO ^XMD
- +3 SET ZTREQ="@"
- QUIT