- IBDFDEA ;ALB/AAS - AICS Data Entry API ; 19-JUN-96
- ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- ;
- ;
- EN1(PXCA,IBDF) ; -- Procedure
- ; -- supported reference to process encounter form data.
- ; Packages that know patient, visit date/time, and clinic
- ; can call this api to use the AICS data entry system to prompt
- ; users for encounter data and subsequently store this data
- ; using the PCE device interface (this is done automatically using
- ; the aics parameters).
- ; D EN1^IBDFDEA(.RESULTS,.IBDF)
- ;
- ; -- Input: PXCA, called by reference, the results of processing
- ; are returned in this array. See PCE device inteface
- ; manual for description of data nodes
- ; IBDF, called by reference
- ; IBDF("APPT") := Appointment Date Time (required)
- ; IBDF("DFN") := pointer to patient file (required)
- ; IBDF("CLINIC") := pointer to hospital location file (44)
- ; (optional) if clinic not defined and no
- ; form printed, no data entry allowed
- ; IBDF("NOAPPT") := (optional) if AICS parameters allow
- ; making follow up appointments, setting
- ; this to any non-zero value will suppress
- ; the ability to add followup appointments
- ; IBDF("PROVIDER") := (optional) if defined, will be used as
- ; primary provider for data entry, use
- ; for provider data entry options
- ;
- N %,%H,C,I,J,X,Y,ADD,DEL,ASKOTHER,DIR,DIC,DA,CNT,DFN,DIRUT,DUOUT,DTOUT,POP,RTN,FRMDATA,IBY,IBQUIT,IBDOBJ,IBDPTSTI,IBDPTSTE,IBDPTNM,IBDPTDTI,SEL
- N IBDPTDTE,IBDFMNME,IBDFMIEN,IBDFMSTI,IBDFMSTE,IBDFMIDI,IBDCLNME,IBFORM,IBDCLNPH,IBDPID,IBDPTPRI,IBDSEL,IBDPI,IBDCO,SDCLST,PXCASTAT,PXKNODA,PXKNODB,IBDREDIT,IBDASK,IBDPRE,IBDOK
- N ANS1,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,FORMLST
- ;
- I '$D(IOF) D HOME^%ZIS
- G:'$G(IBDF("DFN")) EN1Q S DFN=IBDF("DFN")
- G:'$G(IBDF("APPT")) EN1Q
- S IBQUIT=0
- ;
- ; -- if no form create entry
- S FORMLST=$$FINDID^IBDF18C(DFN,IBDF("APPT"),"",1)
- I FORMLST="",$G(IBDF("CLINIC")) D ANYWAY^IBDFDE6
- ;
- G:IBQUIT EN1Q
- ;
- I FORMLST F IBDX=1:1 S IBDF("FORM")=$P(FORMLST,"^",IBDX) Q:IBDF("FORM")="" I IBDF("FORM")'="" D EN^IBDFDE K IBDSEL,IBDPI Q:IBQUIT
- ;
- EN1Q Q
- ;
- SCANFRM(X) ; is entry scannable
- Q +$P($G(^IBE(357,+$P($G(^IBD(357.95,+$P($G(^IBD(357.96,X,0)),"^",4),0)),"^",21),0)),"^",12)
- ;
- DELFT ; -- Delete forms Tracking Entry
- N I,J,IBD,DIR,DIRUT,VALMY,IBDF,IBDNODE,DFN,APPT,IBX,CLN,IBQUIT,FORMID
- D EN^VALM2($G(XQORNOD(0)))
- I $D(VALMY) D FULL^VALM1 S IBD=0 F S IBD=$O(VALMY(IBD)) Q:'IBD!$D(DIRUT) D
- .S IBDF=$P($G(^TMP("FRMIDX",$J,+IBD)),"^",2)
- .S IBDNODE=$G(^IBD(357.96,+IBDF,0)) I IBDNODE="" W !,"No Form Tracking record associated with entry #",IBD H 2 Q
- .I $D(^XUSEC("IBD MANAGER",DUZ)) D
- ..S IBX=$P(IBDNODE,"^",11) I IBX>1,IBX<20 W !!,"***** Status indicates action has been taken on this entry #"_IBD_" *****"
- ..W !!?25,"*** Entry #"_IBD_" STATUS: "_$S(IBX=1:"PRINTED",IBX=2:"SCANNED",IBX=3:"SCD/PCE",IBX=4:"SCD w/ER",IBX=5:"DENTRY",IBX=6:"DE to PCE",IBX=7:"DE w/ER",IBX=11:"PEND Pgs",IBX=12:"NO TRANS",20:"AVAIL DE",1:"NOT PRNT")_" ***"
- .I '$D(^XUSEC("IBD MANAGER",DUZ)) D
- ..S DFN=$P(IBDNODE,"^",2),APPT=$P(IBDNODE,"^",3),CLN=$P(IBDNODE,"^",10),FORMID=$P(IBDNODE,"^",4)
- ..I $D(^DPT(DFN,"S",APPT,0)),$P(^DPT(DFN,"S",APPT,0),"^",1)=CLN D ; !,"Entry #"_IBD_" - Nothing Deleted...Deleting entries only allowed for entries not associated with an appointment." H 2 S IBQUIT=1 Q
- ...I $D(^IBD(357.95,FORMID,0)),'$P(^IBD(357.95,FORMID,0),"^",2) W !,"Entry #"_IBD_" - Nothing Deleted...This entry is associated with an appointment, and is the most current version of the form." H 2 S IBQUIT=1 Q
- ..;I $P(IBDNODE,"^",11)>1,$P(IBDNODE,"^",11)<20 W !,"Status indicates action taken on this entry, deletion not allowed." H 2 Q
- .I '$D(IBQUIT) W ! S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are You Sure you want to delete entry #"_IBD
- .I '$D(IBQUIT) D ^DIR I Y'=1 W !,"Entry #",IBD," not Deleted!" H 2 Q
- .I '$D(IBQUIT) D DP1
- .K IBQUIT
- I '$D(VALMY) G DTQ1
- ;
- DTQ K ^TMP("CNT",$J),^TMP("FRM",$J),^TMP("FTRK",$J),^TMP("STATS",$J),^TMP("FRMIDX",$J),^TMP("STAIDX",$J)
- D EXIT1^IBDFFT,START^IBDFFT1
- DTQ1 S VALMBCK="R" Q
- ;
- DP1 ; -- actual deletion of forms tracking entry
- N DA,DIC,DIK
- S DA=IBDF,DIK="^IBD(357.96," D ^DIK
- W !,"Entry ",IBD," Deleted!"
- Q
- IBDFDEA ;ALB/AAS - AICS Data Entry API ; 19-JUN-96
- +1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- +2 ;
- +3 ;
- EN1(PXCA,IBDF) ; -- Procedure
- +1 ; -- supported reference to process encounter form data.
- +2 ; Packages that know patient, visit date/time, and clinic
- +3 ; can call this api to use the AICS data entry system to prompt
- +4 ; users for encounter data and subsequently store this data
- +5 ; using the PCE device interface (this is done automatically using
- +6 ; the aics parameters).
- +7 ; D EN1^IBDFDEA(.RESULTS,.IBDF)
- +8 ;
- +9 ; -- Input: PXCA, called by reference, the results of processing
- +10 ; are returned in this array. See PCE device inteface
- +11 ; manual for description of data nodes
- +12 ; IBDF, called by reference
- +13 ; IBDF("APPT") := Appointment Date Time (required)
- +14 ; IBDF("DFN") := pointer to patient file (required)
- +15 ; IBDF("CLINIC") := pointer to hospital location file (44)
- +16 ; (optional) if clinic not defined and no
- +17 ; form printed, no data entry allowed
- +18 ; IBDF("NOAPPT") := (optional) if AICS parameters allow
- +19 ; making follow up appointments, setting
- +20 ; this to any non-zero value will suppress
- +21 ; the ability to add followup appointments
- +22 ; IBDF("PROVIDER") := (optional) if defined, will be used as
- +23 ; primary provider for data entry, use
- +24 ; for provider data entry options
- +25 ;
- +26 NEW %,%H,C,I,J,X,Y,ADD,DEL,ASKOTHER,DIR,DIC,DA,CNT,DFN,DIRUT,DUOUT,DTOUT,POP,RTN,FRMDATA,IBY,IBQUIT,IBDOBJ,IBDPTSTI,IBDPTSTE,IBDPTNM,IBDPTDTI,SEL
- +27 NEW IBDPTDTE,IBDFMNME,IBDFMIEN,IBDFMSTI,IBDFMSTE,IBDFMIDI,IBDCLNME,IBFORM,IBDCLNPH,IBDPID,IBDPTPRI,IBDSEL,IBDPI,IBDCO,SDCLST,PXCASTAT,PXKNODA,PXKNODB,IBDREDIT,IBDASK,IBDPRE,IBDOK
- +28 NEW ANS1,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,FORMLST
- +29 ;
- +30 IF '$DATA(IOF)
- DO HOME^%ZIS
- +31 IF '$GET(IBDF("DFN"))
- GOTO EN1Q
- SET DFN=IBDF("DFN")
- +32 IF '$GET(IBDF("APPT"))
- GOTO EN1Q
- +33 SET IBQUIT=0
- +34 ;
- +35 ; -- if no form create entry
- +36 SET FORMLST=$$FINDID^IBDF18C(DFN,IBDF("APPT"),"",1)
- +37 IF FORMLST=""
- IF $GET(IBDF("CLINIC"))
- DO ANYWAY^IBDFDE6
- +38 ;
- +39 IF IBQUIT
- GOTO EN1Q
- +40 ;
- +41 IF FORMLST
- FOR IBDX=1:1
- SET IBDF("FORM")=$PIECE(FORMLST,"^",IBDX)
- IF IBDF("FORM")=""
- QUIT
- IF IBDF("FORM")'=""
- DO EN^IBDFDE
- KILL IBDSEL,IBDPI
- IF IBQUIT
- QUIT
- +42 ;
- EN1Q QUIT
- +1 ;
- SCANFRM(X) ; is entry scannable
- +1 QUIT +$PIECE($GET(^IBE(357,+$PIECE($GET(^IBD(357.95,+$PIECE($GET(^IBD(357.96,X,0)),"^",4),0)),"^",21),0)),"^",12)
- +2 ;
- DELFT ; -- Delete forms Tracking Entry
- +1 NEW I,J,IBD,DIR,DIRUT,VALMY,IBDF,IBDNODE,DFN,APPT,IBX,CLN,IBQUIT,FORMID
- +2 DO EN^VALM2($GET(XQORNOD(0)))
- +3 IF $DATA(VALMY)
- DO FULL^VALM1
- SET IBD=0
- FOR
- SET IBD=$ORDER(VALMY(IBD))
- IF 'IBD!$DATA(DIRUT)
- QUIT
- Begin DoDot:1
- +4 SET IBDF=$PIECE($GET(^TMP("FRMIDX",$JOB,+IBD)),"^",2)
- +5 SET IBDNODE=$GET(^IBD(357.96,+IBDF,0))
- IF IBDNODE=""
- WRITE !,"No Form Tracking record associated with entry #",IBD
- HANG 2
- QUIT
- +6 IF $DATA(^XUSEC("IBD MANAGER",DUZ))
- Begin DoDot:2
- +7 SET IBX=$PIECE(IBDNODE,"^",11)
- IF IBX>1
- IF IBX<20
- WRITE !!,"***** Status indicates action has been taken on this entry #"_IBD_" *****"
- +8 WRITE !!?25,"*** Entry #"_IBD_" STATUS: "_$SELECT(IBX=1:"PRINTED",IBX=2:"SCANNED",IBX=3:"SCD/PCE",IBX=4:"SCD w/ER",IBX=5:"DENTRY",IBX=6:"DE to PCE",IBX=7:"DE w/ER",IBX=11:"PEND Pgs",IBX=12:"NO TRANS",20:"AVAIL DE",1:"NOT PRN
- T")_" ***"
- End DoDot:2
- +9 IF '$DATA(^XUSEC("IBD MANAGER",DUZ))
- Begin DoDot:2
- +10 SET DFN=$PIECE(IBDNODE,"^",2)
- SET APPT=$PIECE(IBDNODE,"^",3)
- SET CLN=$PIECE(IBDNODE,"^",10)
- SET FORMID=$PIECE(IBDNODE,"^",4)
- +11 ; !,"Entry #"_IBD_" - Nothing Deleted...Deleting entries only allowed for entries not associated with an appointment." H 2 S IBQUIT=1 Q
- IF $DATA(^DPT(DFN,"S",APPT,0))
- IF $PIECE(^DPT(DFN,"S",APPT,0),"^",1)=CLN
- Begin DoDot:3
- +12 IF $DATA(^IBD(357.95,FORMID,0))
- IF '$PIECE(^IBD(357.95,FORMID,0),"^",2)
- WRITE !,"Entry #"_IBD_" - Nothing Deleted...This entry is associated with an appointment, and is the most current version of the form."
- HANG 2
- SET IBQUIT=1
- QUIT
- End DoDot:3
- +13 ;I $P(IBDNODE,"^",11)>1,$P(IBDNODE,"^",11)<20 W !,"Status indicates action taken on this entry, deletion not allowed." H 2 Q
- End DoDot:2
- +14 IF '$DATA(IBQUIT)
- WRITE !
- SET DIR(0)="Y"
- SET DIR("B")="NO"
- SET DIR("A")="Are You Sure you want to delete entry #"_IBD
- +15 IF '$DATA(IBQUIT)
- DO ^DIR
- IF Y'=1
- WRITE !,"Entry #",IBD," not Deleted!"
- HANG 2
- QUIT
- +16 IF '$DATA(IBQUIT)
- DO DP1
- +17 KILL IBQUIT
- End DoDot:1
- +18 IF '$DATA(VALMY)
- GOTO DTQ1
- +19 ;
- DTQ KILL ^TMP("CNT",$JOB),^TMP("FRM",$JOB),^TMP("FTRK",$JOB),^TMP("STATS",$JOB),^TMP("FRMIDX",$JOB),^TMP("STAIDX",$JOB)
- +1 DO EXIT1^IBDFFT
- DO START^IBDFFT1
- DTQ1 SET VALMBCK="R"
- QUIT
- +1 ;
- DP1 ; -- actual deletion of forms tracking entry
- +1 NEW DA,DIC,DIK
- +2 SET DA=IBDF
- SET DIK="^IBD(357.96,"
- DO ^DIK
- +3 WRITE !,"Entry ",IBD," Deleted!"
- +4 QUIT
