- ACHSTXUT ; IHS/ITSC/PMF - DATA TRANMISSION SUBROUTINES ; [ 10/16/2001 8:16 AM ]
- ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
- ;
- W !!,*7,"NOT AN ENTRY POINT"
- Q
- ;
- TXLOGADD ;EP - Add entry to transmission log.
- ;;ACHSEXFS=FILE NAME TO BE ADDED TO TX LOG FILE
- S DIC(0)="ZML"
- K DA,X,Y
- I '$D(ACHSEXFS) G ABEND
- I '$D(DUZ(2)) G ABEND
- I '$D(^AFSTXLOG) G ABEND
- I '$D(^AFSTXLOG(DUZ(2))) S X=$$LOC^ACHS,DIC="^AFSTXLOG(" D ^DIC
- L2 ;
- I $D(^AFSTXLOG(DUZ(2),1,0)) G L3
- LOCK +^AFSTXLOG(DUZ(2),1,0):3
- E W *7,!!,"FILE IN USE BY ANOTHER USER",! G ABEND:'$$DIR^XBDIR("E"),L2
- S ^AFSTXLOG(DUZ(2),1,0)=$$ZEROTH^ACHS(9002320.5,1)
- L3 ;
- S DIC="^AFSTXLOG("_DUZ(2)_",1,",X=ACHSEXFS,DA(1)=DUZ(2)
- D ^DIC
- S ACHSY=+Y
- LOCK -^AFSTXLOG(DUZ(2),1,0):3
- Q
- ;
- ABEND ;
- S (Y,ACHSY)=-1
- Q
- ;
- PT ;EP - From Option. Mark Patient for re-export.
- N DFN
- D PTLK^ACHS
- Q:'$G(DFN)
- W !!,$P(^DPT(DFN,0),U),!
- I '$D(^ACHSF(DUZ(2),"PB",DFN)) W "This patient has no CHS documents on file." Q
- I '$P(^AUPNPAT(DFN,0),U,15) W "has already been marked for export with the next P.O. for them." Q
- W "was last exported on ",$$FMTE^XLFDT($P(^AUPNPAT(DFN,0),U,15)),"."
- Q:'$$DIR^XBDIR("Y","R U Sure you want to mark '"_$P(^DPT(DFN,0),U)_"' for export","N")
- N DIE,DA,DR
- S DIE="^AUPNPAT(",DA=DFN,DR=".15///@"
- D ^DIE
- Q
- ;
- VEN ;EP - From Option. Mark Vendor for re-export.
- N DIC,DA
- S DIC="^AUTTVNDR(",DIC(0)="AEZQM",DIC("A")="Enter Provider/Vendor: "
- D ^DIC
- Q:Y<1
- S DA=+Y
- W !!,$P(^AUTTVNDR(DA,0),U),!
- I '$D(^ACHSF(DUZ(2),"VB",DA)) W "This vendor has no CHS documents on file.",! Q
- I '$P(^AUTTVNDR(DA,11),U,12) W "has already been marked for export with the next P.O. for them." Q
- W "was last exported on ",$$FMTE^XLFDT($P(^AUTTVNDR(DA,11),U,12)),"."
- Q:'$$DIR^XBDIR("Y","R U Sure you want to mark '"_$P(^AUTTVNDR(DA,0),U)_"' for export","N")
- N DIE,DR
- S DIE="^AUTTVNDR(",DR="1112///@"
- D ^DIE
- Q
- ;
- ACHSTXUT ; IHS/ITSC/PMF - DATA TRANMISSION SUBROUTINES ; [ 10/16/2001 8:16 AM ]
- +1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
- +2 ;
- +3 WRITE !!,*7,"NOT AN ENTRY POINT"
- +4 QUIT
- +5 ;
- TXLOGADD ;EP - Add entry to transmission log.
- +1 ;;ACHSEXFS=FILE NAME TO BE ADDED TO TX LOG FILE
- +2 SET DIC(0)="ZML"
- +3 KILL DA,X,Y
- +4 IF '$DATA(ACHSEXFS)
- GOTO ABEND
- +5 IF '$DATA(DUZ(2))
- GOTO ABEND
- +6 IF '$DATA(^AFSTXLOG)
- GOTO ABEND
- +7 IF '$DATA(^AFSTXLOG(DUZ(2)))
- SET X=$$LOC^ACHS
- SET DIC="^AFSTXLOG("
- DO ^DIC
- L2 ;
- +1 IF $DATA(^AFSTXLOG(DUZ(2),1,0))
- GOTO L3
- +2 LOCK +^AFSTXLOG(DUZ(2),1,0):3
- +3 IF '$TEST
- WRITE *7,!!,"FILE IN USE BY ANOTHER USER",!
- IF '$$DIR^XBDIR("E")
- GOTO ABEND
- GOTO L2
- +4 SET ^AFSTXLOG(DUZ(2),1,0)=$$ZEROTH^ACHS(9002320.5,1)
- L3 ;
- +1 SET DIC="^AFSTXLOG("_DUZ(2)_",1,"
- SET X=ACHSEXFS
- SET DA(1)=DUZ(2)
- +2 DO ^DIC
- +3 SET ACHSY=+Y
- +4 LOCK -^AFSTXLOG(DUZ(2),1,0):3
- +5 QUIT
- +6 ;
- ABEND ;
- +1 SET (Y,ACHSY)=-1
- +2 QUIT
- +3 ;
- PT ;EP - From Option. Mark Patient for re-export.
- +1 NEW DFN
- +2 DO PTLK^ACHS
- +3 IF '$GET(DFN)
- QUIT
- +4 WRITE !!,$PIECE(^DPT(DFN,0),U),!
- +5 IF '$DATA(^ACHSF(DUZ(2),"PB",DFN))
- WRITE "This patient has no CHS documents on file."
- QUIT
- +6 IF '$PIECE(^AUPNPAT(DFN,0),U,15)
- WRITE "has already been marked for export with the next P.O. for them."
- QUIT
- +7 WRITE "was last exported on ",$$FMTE^XLFDT($PIECE(^AUPNPAT(DFN,0),U,15)),"."
- +8 IF '$$DIR^XBDIR("Y","R U Sure you want to mark '"_$PIECE(^DPT(DFN,0),U)_"' for export","N")
- QUIT
- +9 NEW DIE,DA,DR
- +10 SET DIE="^AUPNPAT("
- SET DA=DFN
- SET DR=".15///@"
- +11 DO ^DIE
- +12 QUIT
- +13 ;
- VEN ;EP - From Option. Mark Vendor for re-export.
- +1 NEW DIC,DA
- +2 SET DIC="^AUTTVNDR("
- SET DIC(0)="AEZQM"
- SET DIC("A")="Enter Provider/Vendor: "
- +3 DO ^DIC
- +4 IF Y<1
- QUIT
- +5 SET DA=+Y
- +6 WRITE !!,$PIECE(^AUTTVNDR(DA,0),U),!
- +7 IF '$DATA(^ACHSF(DUZ(2),"VB",DA))
- WRITE "This vendor has no CHS documents on file.",!
- QUIT
- +8 IF '$PIECE(^AUTTVNDR(DA,11),U,12)
- WRITE "has already been marked for export with the next P.O. for them."
- QUIT
- +9 WRITE "was last exported on ",$$FMTE^XLFDT($PIECE(^AUTTVNDR(DA,11),U,12)),"."
- +10 IF '$$DIR^XBDIR("Y","R U Sure you want to mark '"_$PIECE(^AUTTVNDR(DA,0),U)_"' for export","N")
- QUIT
- +11 NEW DIE,DR
- +12 SET DIE="^AUTTVNDR("
- SET DR="1112///@"
- +13 DO ^DIE
- +14 QUIT
- +15 ;
