PSOPTC0 ;AITC/PD - Patient Billing Comments;9/5/2017
;;7.0;OUTPATIENT PHARMACY;**482,704**;DEC 1997;Build 16
;
EN ; Menu Option Entry Point
;
I '$D(^XUSEC("PSO EPHARMACY SITE MANAGER",DUZ)) W !,$C(7),"Requires Pharmacy Key (PSO EPHARMACY SITE MANAGER) !" Q
;
N DIC,DTOUT,X,Y
;
K PSOPTC
;
;Division selection
I '$G(PSOSITE) D ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! G EXIT
;
;Patient selection
W !!
S DIC=2,DIC(0)="QEAM"
D ^DIC
G EXIT:((Y<0)!($D(DTOUT)))
S PSOPTC("DFN")=+Y
;
D EN^VALM("PSO PATIENT COMMENT")
;
Q
;
HDR ; Header
;
N DFN,H1,H2,VA,VADM
;
S DFN=$G(PSOPTC("DFN"))
I 'DFN G EXIT
D DEM^VADPT
S H1=$$LJ^XLFSTR("Patient: "_$E($G(VADM(1)),1,30)_" ("_$G(VA("BID"))_")",48)
S $E(H1,57)=$$LJ^XLFSTR("DOB: "_$$FMTE^XLFDT($P($G(VADM(3)),U,1),"2Z")_" ("_$G(VADM(4))_")",22)
S H2=$$LJ^XLFSTR("Birth Sex: "_$P($G(VADM(5)),U,1),8)
S $E(H2,32)="Self-Identified Gender: "_$E($P($G(VADM(14,5)),U,1),1,24)
;
S VALMHDR(1)=H1
S VALMHDR(2)=H2
S VALMHDR(3)="# STATUS DATE/TIME USER"
Q
;
INIT ;
;
D CLEAN^VALM10
D BUILD
Q
;
BUILD ; Build ListMan Screen
;
; PSODFN = Patient Record ID
; PSOPC = PATIENT COMMENT sub-file (#55.17) Record ID
;
N DIWL,DIWR,PSOCNT,PSOCOM,PSOCOMMENT,PSODATA,PSODATE,PSODATE1
N PSODFN,PSOLINE,PSOPC,PSOSTATUS,PSOSTR,PSOUSER,PSOY
;
S PSOLINE=0
S PSOCNT=0
S PSODFN=$G(PSOPTC("DFN"))
I 'PSODFN G EXIT
;
; Loop through the PATIENT COMMENT sub-file (#55.17) in reverse
; chronological order.
S PSODATE=""
F S PSODATE=$O(^PS(55,PSODFN,"PC","B",PSODATE),-1) Q:PSODATE="" D
. S PSOPC=$O(^PS(55,PSODFN,"PC","B",PSODATE,""))
. K PSODATA
. D GETS^DIQ(55.17,PSOPC_","_PSODFN_",",".01;1;2;3","E","PSODATA")
. S PSODATE1=$G(PSODATA(55.17,PSOPC_","_PSODFN_",",.01,"E"))
. S PSOUSER=$G(PSODATA(55.17,PSOPC_","_PSODFN_",",1,"E"))
. S PSOSTATUS=$G(PSODATA(55.17,PSOPC_","_PSODFN_",",2,"E"))
. S PSOCOMMENT=$G(PSODATA(55.17,PSOPC_","_PSODFN_",",3,"E"))
. S PSOCNT=PSOCNT+1
. S PSOSTR=PSOCNT_" "_$E(PSOSTATUS)_" "_PSODATE1_" "_PSOUSER
. S PSOLINE=PSOLINE+1
. S @VALMAR@("IDX",PSOCNT,PSOPC)=""
. D SET^VALM10(PSOLINE,PSOSTR,"")
. ; Use ^DIWP to format comment into lines no greater than 78 characters
. ; with logical breaks between words.
. K ^UTILITY($J,"W")
. S X=PSOCOMMENT,DIWL=1,DIWR=78
. D ^DIWP
. F PSOY=1:1 Q:('$D(^UTILITY($J,"W",1,PSOY,0))) D
. . S PSOCOM=$G(^UTILITY($J,"W",1,PSOY,0))
. . S PSOLINE=PSOLINE+1
. . D SET^VALM10(PSOLINE," "_PSOCOM,"")
. K ^UTILITY($J,"W")
;
S VALMCNT=PSOLINE
;
Q
;
ADD ; Add Patient Comment
;
N PSO55,PSOCOM
;
D FULL^VALM1
S PSOCOM=$$COMMENT("Comment: ",150)
; Comment not confirmed or user entered ^ to Exit
I $L(PSOCOM)=0!(PSOCOM["^") S VALMBCK="R" Q
S PSO55=$G(PSOPTC("DFN"))
; Valid comment entered - Create new multiple record
D ADDPC(PSOCOM,PSO55)
D INIT
S VALMBCK="R"
;
Q
;
;Enter a comment
;PSOTR -prompt string
;PSMLEN -maxlen
;returns:
; "^" - if user chose to quit
; "" - nothing entered or input has been discarded
; otherwise - comment's text
N DIR,DTOUT,DUOUT,PSQ
I '$D(PSOTR) S PSOTR="Comment "
I '$D(PSMLEN) S PSMLEN=150
S DIR(0)="FA^1:150"
S DIR("A")=PSOTR
S DIR("?")="Enter a free text comment up to 150 characters long."
S PSQ=0
F D Q:+PSQ'=0
. W ! D ^DIR
. I $D(DUOUT)!($D(DTOUT)) S PSQ=-1 Q
. I $L(Y)'>PSMLEN S PSQ=1 Q
. W !!,"Enter a free text comment up to 150 characters long.",!
. S DIR("B")=$E(Y,1,PSMLEN)
Q:PSQ<0 "^"
Q:$L(Y)=0 ""
S PSQ=$$YESNO^PSOREJP3("Are you sure Y/N")
I PSQ=-1 Q "^"
I PSQ=0 Q ""
Q Y
;
;
ADDPC(PSOCOM,PSO55) ; Add new multiple record for Patient Comment
;
N PSO200,PSOAR,PSOFILE,PSOIEN,PSONOW,PSOPC
;
; Create the Patient Comment multiple
S PSOFILE=55.17
D NOW^%DTC
S PSONOW=%
S PSOAR(1,PSOFILE,"+1,"_PSO55_",",.01)=PSONOW
D UPDATE^DIE("","PSOAR(1)") K PSOAR
;
; Populate the data into the Patient Comment multiple
S PSO200=DUZ
S PSOPC=$O(^PS(55,PSO55,"PC","B",PSONOW,""))
S PSOIEN=PSOPC_","_PSO55_","
S PSOAR(PSOFILE,PSOIEN,1)=PSO200
S PSOAR(PSOFILE,PSOIEN,2)="Y"
S PSOAR(PSOFILE,PSOIEN,3)=PSOCOM
D FILE^DIE(,"PSOAR") K PSOAR
;
; Add Patient Comment History
D ADDPCH(PSO55,PSOPC,PSONOW,1)
;
Q
;
ADDPCH(PSO55,PSOPC,PSONOW,PSOACT) ; Add new multiple record for Patient Comment History
;
N PSO200,PSOAR,PSOFILE,PSOIEN,PSOPCH
;
; Create the Patient Comment History multiple
S PSOFILE=55.174
S PSO200=DUZ
S PSOAR(1,PSOFILE,"+1,"_PSOPC_","_PSO55_",",.01)=PSONOW
D UPDATE^DIE("","PSOAR(1)")
K PSOAR
;
; Populate the data into the Patient Comment History multiple
S PSOPCH=$O(^PS(55,PSO55,"PC",PSOPC,"PCH","B",PSONOW,""))
S PSOIEN=PSOPCH_","_PSOPC_","_PSO55_","
S PSOAR(PSOFILE,PSOIEN,1)=PSO200
S PSOAR(PSOFILE,PSOIEN,2)=PSOACT
D FILE^DIE(,"PSOAR") K PSOAR
;
Q
;
ACT ; Activate / Inactivate Patient Comment
;
; ACT serves as a toggle for Activating and Inactivating comments.
; Upon selection of this action, the user will be prompted for
; the line to Activate/Inactivate. The comment will be redisplayed
; to the user. A confirmation prompt will appear. Upon confirmation,
; the value will be updated and the display refreshed.
; If the user confirmed to change the status of the comment, a history
; record will be filed.
;
N DIWL,DIWR,PSO55,PSOACT,PSOACT1,PSOAR,PSOCOM,PSODATA,PSOFILE
N PSOLINE,PSOIEN,PSONOW,PSONOWH,PSOPC,PSOY,PSOYESNO
;
; Get record id (#55.17) for selected entry
S PSOPC=$$SELECT(.PSOLINE)
;
I PSOPC="^" S VALMBCK="R" Q
;
S PSOFILE=55.17
S PSO55=PSOPTC("DFN")
K PSODATA
S PSOIEN=PSOPC_","_PSO55_","
D GETS^DIQ(55.17,PSOIEN,".01;2;3","I","PSODATA")
S PSONOW=$G(PSODATA(55.17,PSOIEN,.01,"I"))
S PSOACT="Activate"
S PSOACT1=$G(PSODATA(55.17,PSOIEN,2,"I"))
I PSOACT1="Y" S PSOACT="Inactivate"
W !,PSOACT_" Comment # "_PSOLINE_":"
I $L($G(PSODATA(55.17,PSOIEN,3,"I")))>78 D
. K ^UTILITY($J,"W")
. S X=PSODATA(55.17,PSOIEN,3,"I"),DIWL=1,DIWR=78
. D ^DIWP
. F PSOY=1:1 Q:('$D(^UTILITY($J,"W",1,PSOY,0))) D
. . S PSOCOM=$G(^UTILITY($J,"W",1,PSOY,0))
. . W !," "_PSOCOM
. K ^UTILITY($J,"W")
E W !," "_PSODATA(55.17,PSOIEN,3,"I")
;
S PSOYESNO=$$YESNO^PSOREJP3("Are you sure Y/N")
I PSOYESNO=-1 G ACTX
;
I PSOYESNO=1 D
. S PSOAR(PSOFILE,PSOIEN,2)="N"
. I PSOACT1="N" S PSOAR(PSOFILE,PSOIEN,2)="Y"
. D FILE^DIE(,"PSOAR") K PSOAR
. ;
. ; Add Patient Comment History
. D NOW^%DTC
. S PSONOWH=%
. I PSOACT1="Y" D ADDPCH(PSO55,PSOPC,PSONOWH,3)
. I PSOACT1="N" D ADDPCH(PSO55,PSOPC,PSONOWH,2)
;
ACTX ;
;
D INIT
S VALMBCK="R"
;
Q
;
HIST ; Patient Comment History
;
; HIST provides a historical view of any Patient Comment.
; The user will be prompted to select a Patient Comment. The
; comment will be redisplayed to the user. A listing of the
; comment's history will display in reverse chronological order.
; The values in this listing will include ADD, ACTIVATE and
; INACTIVATE. The date/time and user for each historical
; update will display.
;
N DIWL,DIWR,PSO55,PSOCOM,PSODATA,PSOIEN,PSOLINE
N PSONOW,PSOPC,PSOPCH,PSOY
;
S PSOPC=$$SELECT(.PSOLINE)
;
I PSOPC="^" S VALMBCK="R" Q
;
S PSO55=PSOPTC("DFN")
;
W !
S PSOIEN=PSOPC_","_PSO55_","
K PSODATA
D GETS^DIQ(55.17,PSOIEN,".01;2;3","I","PSODATA")
I $L($G(PSODATA(55.17,PSOIEN,3,"I")))>78 D
. K ^UTILITY($J,"W")
. S X=PSODATA(55.17,PSOIEN,3,"I"),DIWL=1,DIWR=78
. D ^DIWP
. F PSOY=1:1 Q:('$D(^UTILITY($J,"W",1,PSOY,0))) D
. . S PSOCOM=$G(^UTILITY($J,"W",1,PSOY,0))
. . W !," "_PSOCOM
. K ^UTILITY($J,"W")
E W !," "_PSODATA(55.17,PSOIEN,3,"I")
W !
;
S PSONOW=""
F S PSONOW=$O(^PS(55,PSO55,"PC",PSOPC,"PCH","B",PSONOW),-1) Q:PSONOW="" D
. S PSOPCH=""
. S PSOPCH=$O(^PS(55,PSO55,"PC",PSOPC,"PCH","B",PSONOW,PSOPCH))
. S PSOIEN=PSOPCH_","_PSOPC_","_PSO55_","
. K PSODATA
. D GETS^DIQ(55.174,PSOIEN,".01;1;2","E","PSODATA")
. W !,$G(PSODATA(55.174,PSOIEN,2,"E"))
. W ?15,$G(PSODATA(55.174,PSOIEN,.01,"E"))
. W ?45,$G(PSODATA(55.174,PSOIEN,1,"E"))
;
D WAIT^VALM1
;
D INIT
S VALMBCK="R"
;
Q
;
SELECT(PSOLINE) ; Select Line from List View
;
N DIR,DIRUT,PSOMAX,Y
;
D FULL^VALM1
;
I '$D(^TMP("PSOPTC0",$J)) D Q "^"
. W !!,"No Patient Comments available for selection."
. D WAIT^VALM1
;
S PSOMAX=$O(^TMP("PSOPTC0",$J,"IDX",""),-1)
;
I PSOMAX=1 S PSOLINE=1 Q $O(^TMP("PSOPTC0",$J,"IDX",PSOLINE,""))
;
W !
S DIR(0)="N^1:"_PSOMAX
S DIR("A")="Line"
I PSOMAX=1 S DIR("B")=PSOMAX
D ^DIR
;
I $D(DIRUT) Q "^"
S PSOLINE=Y
;
Q $O(^TMP("PSOPTC0",$J,"IDX",PSOLINE,""))
;
HELP ;
;
Q
;
EXIT ;
;
K ^TMP("PSOPTC0",$J),PSOPTC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOPTC0 8889 printed Dec 13, 2024@02:33:10 Page 2
PSOPTC0 ;AITC/PD - Patient Billing Comments;9/5/2017
+1 ;;7.0;OUTPATIENT PHARMACY;**482,704**;DEC 1997;Build 16
+2 ;
EN ; Menu Option Entry Point
+1 ;
+2 IF '$DATA(^XUSEC("PSO EPHARMACY SITE MANAGER",DUZ))
WRITE !,$CHAR(7),"Requires Pharmacy Key (PSO EPHARMACY SITE MANAGER) !"
QUIT
+3 ;
+4 NEW DIC,DTOUT,X,Y
+5 ;
+6 KILL PSOPTC
+7 ;
+8 ;Division selection
+9 IF '$GET(PSOSITE)
DO ^PSOLSET
IF '$DATA(PSOPAR)
WRITE $CHAR(7),!!,"Pharmacy Division Must be Selected!",!
GOTO EXIT
+10 ;
+11 ;Patient selection
+12 WRITE !!
+13 SET DIC=2
SET DIC(0)="QEAM"
+14 DO ^DIC
+15 if ((Y<0)!($DATA(DTOUT)))
GOTO EXIT
+16 SET PSOPTC("DFN")=+Y
+17 ;
+18 DO EN^VALM("PSO PATIENT COMMENT")
+19 ;
+20 QUIT
+21 ;
HDR ; Header
+1 ;
+2 NEW DFN,H1,H2,VA,VADM
+3 ;
+4 SET DFN=$GET(PSOPTC("DFN"))
+5 IF 'DFN
GOTO EXIT
+6 DO DEM^VADPT
+7 SET H1=$$LJ^XLFSTR("Patient: "_$EXTRACT($GET(VADM(1)),1,30)_" ("_$GET(VA("BID"))_")",48)
+8 SET $EXTRACT(H1,57)=$$LJ^XLFSTR("DOB: "_$$FMTE^XLFDT($PIECE($GET(VADM(3)),U,1),"2Z")_" ("_$GET(VADM(4))_")",22)
+9 SET H2=$$LJ^XLFSTR("Birth Sex: "_$PIECE($GET(VADM(5)),U,1),8)
+10 SET $EXTRACT(H2,32)="Self-Identified Gender: "_$EXTRACT($PIECE($GET(VADM(14,5)),U,1),1,24)
+11 ;
+12 SET VALMHDR(1)=H1
+13 SET VALMHDR(2)=H2
+14 SET VALMHDR(3)="# STATUS DATE/TIME USER"
+15 QUIT
+16 ;
INIT ;
+1 ;
+2 DO CLEAN^VALM10
+3 DO BUILD
+4 QUIT
+5 ;
BUILD ; Build ListMan Screen
+1 ;
+2 ; PSODFN = Patient Record ID
+3 ; PSOPC = PATIENT COMMENT sub-file (#55.17) Record ID
+4 ;
+5 NEW DIWL,DIWR,PSOCNT,PSOCOM,PSOCOMMENT,PSODATA,PSODATE,PSODATE1
+6 NEW PSODFN,PSOLINE,PSOPC,PSOSTATUS,PSOSTR,PSOUSER,PSOY
+7 ;
+8 SET PSOLINE=0
+9 SET PSOCNT=0
+10 SET PSODFN=$GET(PSOPTC("DFN"))
+11 IF 'PSODFN
GOTO EXIT
+12 ;
+13 ; Loop through the PATIENT COMMENT sub-file (#55.17) in reverse
+14 ; chronological order.
+15 SET PSODATE=""
+16 FOR
SET PSODATE=$ORDER(^PS(55,PSODFN,"PC","B",PSODATE),-1)
if PSODATE=""
QUIT
Begin DoDot:1
+17 SET PSOPC=$ORDER(^PS(55,PSODFN,"PC","B",PSODATE,""))
+18 KILL PSODATA
+19 DO GETS^DIQ(55.17,PSOPC_","_PSODFN_",",".01;1;2;3","E","PSODATA")
+20 SET PSODATE1=$GET(PSODATA(55.17,PSOPC_","_PSODFN_",",.01,"E"))
+21 SET PSOUSER=$GET(PSODATA(55.17,PSOPC_","_PSODFN_",",1,"E"))
+22 SET PSOSTATUS=$GET(PSODATA(55.17,PSOPC_","_PSODFN_",",2,"E"))
+23 SET PSOCOMMENT=$GET(PSODATA(55.17,PSOPC_","_PSODFN_",",3,"E"))
+24 SET PSOCNT=PSOCNT+1
+25 SET PSOSTR=PSOCNT_" "_$EXTRACT(PSOSTATUS)_" "_PSODATE1_" "_PSOUSER
+26 SET PSOLINE=PSOLINE+1
+27 SET @VALMAR@("IDX",PSOCNT,PSOPC)=""
+28 DO SET^VALM10(PSOLINE,PSOSTR,"")
+29 ; Use ^DIWP to format comment into lines no greater than 78 characters
+30 ; with logical breaks between words.
+31 KILL ^UTILITY($JOB,"W")
+32 SET X=PSOCOMMENT
SET DIWL=1
SET DIWR=78
+33 DO ^DIWP
+34 FOR PSOY=1:1
if ('$DATA(^UTILITY($JOB,"W",1,PSOY,0)))
QUIT
Begin DoDot:2
+35 SET PSOCOM=$GET(^UTILITY($JOB,"W",1,PSOY,0))
+36 SET PSOLINE=PSOLINE+1
+37 DO SET^VALM10(PSOLINE," "_PSOCOM,"")
End DoDot:2
+38 KILL ^UTILITY($JOB,"W")
End DoDot:1
+39 ;
+40 SET VALMCNT=PSOLINE
+41 ;
+42 QUIT
+43 ;
ADD ; Add Patient Comment
+1 ;
+2 NEW PSO55,PSOCOM
+3 ;
+4 DO FULL^VALM1
+5 SET PSOCOM=$$COMMENT("Comment: ",150)
+6 ; Comment not confirmed or user entered ^ to Exit
+7 IF $LENGTH(PSOCOM)=0!(PSOCOM["^")
SET VALMBCK="R"
QUIT
+8 SET PSO55=$GET(PSOPTC("DFN"))
+9 ; Valid comment entered - Create new multiple record
+10 DO ADDPC(PSOCOM,PSO55)
+11 DO INIT
+12 SET VALMBCK="R"
+13 ;
+14 QUIT
+15 ;
+16 ;Enter a comment
+17 ;PSOTR -prompt string
+18 ;PSMLEN -maxlen
+19 ;returns:
+20 ; "^" - if user chose to quit
+21 ; "" - nothing entered or input has been discarded
+22 ; otherwise - comment's text
+1 NEW DIR,DTOUT,DUOUT,PSQ
+2 IF '$DATA(PSOTR)
SET PSOTR="Comment "
+3 IF '$DATA(PSMLEN)
SET PSMLEN=150
+4 SET DIR(0)="FA^1:150"
+5 SET DIR("A")=PSOTR
+6 SET DIR("?")="Enter a free text comment up to 150 characters long."
+7 SET PSQ=0
+8 FOR
Begin DoDot:1
+9 WRITE !
DO ^DIR
+10 IF $DATA(DUOUT)!($DATA(DTOUT))
SET PSQ=-1
QUIT
+11 IF $LENGTH(Y)'>PSMLEN
SET PSQ=1
QUIT
+12 WRITE !!,"Enter a free text comment up to 150 characters long.",!
+13 SET DIR("B")=$EXTRACT(Y,1,PSMLEN)
End DoDot:1
if +PSQ'=0
QUIT
+14 if PSQ<0
QUIT "^"
+15 if $LENGTH(Y)=0
QUIT ""
+16 SET PSQ=$$YESNO^PSOREJP3("Are you sure Y/N")
+17 IF PSQ=-1
QUIT "^"
+18 IF PSQ=0
QUIT ""
+19 QUIT Y
+20 ;
+21 ;
ADDPC(PSOCOM,PSO55) ; Add new multiple record for Patient Comment
+1 ;
+2 NEW PSO200,PSOAR,PSOFILE,PSOIEN,PSONOW,PSOPC
+3 ;
+4 ; Create the Patient Comment multiple
+5 SET PSOFILE=55.17
+6 DO NOW^%DTC
+7 SET PSONOW=%
+8 SET PSOAR(1,PSOFILE,"+1,"_PSO55_",",.01)=PSONOW
+9 DO UPDATE^DIE("","PSOAR(1)")
KILL PSOAR
+10 ;
+11 ; Populate the data into the Patient Comment multiple
+12 SET PSO200=DUZ
+13 SET PSOPC=$ORDER(^PS(55,PSO55,"PC","B",PSONOW,""))
+14 SET PSOIEN=PSOPC_","_PSO55_","
+15 SET PSOAR(PSOFILE,PSOIEN,1)=PSO200
+16 SET PSOAR(PSOFILE,PSOIEN,2)="Y"
+17 SET PSOAR(PSOFILE,PSOIEN,3)=PSOCOM
+18 DO FILE^DIE(,"PSOAR")
KILL PSOAR
+19 ;
+20 ; Add Patient Comment History
+21 DO ADDPCH(PSO55,PSOPC,PSONOW,1)
+22 ;
+23 QUIT
+24 ;
ADDPCH(PSO55,PSOPC,PSONOW,PSOACT) ; Add new multiple record for Patient Comment History
+1 ;
+2 NEW PSO200,PSOAR,PSOFILE,PSOIEN,PSOPCH
+3 ;
+4 ; Create the Patient Comment History multiple
+5 SET PSOFILE=55.174
+6 SET PSO200=DUZ
+7 SET PSOAR(1,PSOFILE,"+1,"_PSOPC_","_PSO55_",",.01)=PSONOW
+8 DO UPDATE^DIE("","PSOAR(1)")
+9 KILL PSOAR
+10 ;
+11 ; Populate the data into the Patient Comment History multiple
+12 SET PSOPCH=$ORDER(^PS(55,PSO55,"PC",PSOPC,"PCH","B",PSONOW,""))
+13 SET PSOIEN=PSOPCH_","_PSOPC_","_PSO55_","
+14 SET PSOAR(PSOFILE,PSOIEN,1)=PSO200
+15 SET PSOAR(PSOFILE,PSOIEN,2)=PSOACT
+16 DO FILE^DIE(,"PSOAR")
KILL PSOAR
+17 ;
+18 QUIT
+19 ;
ACT ; Activate / Inactivate Patient Comment
+1 ;
+2 ; ACT serves as a toggle for Activating and Inactivating comments.
+3 ; Upon selection of this action, the user will be prompted for
+4 ; the line to Activate/Inactivate. The comment will be redisplayed
+5 ; to the user. A confirmation prompt will appear. Upon confirmation,
+6 ; the value will be updated and the display refreshed.
+7 ; If the user confirmed to change the status of the comment, a history
+8 ; record will be filed.
+9 ;
+10 NEW DIWL,DIWR,PSO55,PSOACT,PSOACT1,PSOAR,PSOCOM,PSODATA,PSOFILE
+11 NEW PSOLINE,PSOIEN,PSONOW,PSONOWH,PSOPC,PSOY,PSOYESNO
+12 ;
+13 ; Get record id (#55.17) for selected entry
+14 SET PSOPC=$$SELECT(.PSOLINE)
+15 ;
+16 IF PSOPC="^"
SET VALMBCK="R"
QUIT
+17 ;
+18 SET PSOFILE=55.17
+19 SET PSO55=PSOPTC("DFN")
+20 KILL PSODATA
+21 SET PSOIEN=PSOPC_","_PSO55_","
+22 DO GETS^DIQ(55.17,PSOIEN,".01;2;3","I","PSODATA")
+23 SET PSONOW=$GET(PSODATA(55.17,PSOIEN,.01,"I"))
+24 SET PSOACT="Activate"
+25 SET PSOACT1=$GET(PSODATA(55.17,PSOIEN,2,"I"))
+26 IF PSOACT1="Y"
SET PSOACT="Inactivate"
+27 WRITE !,PSOACT_" Comment # "_PSOLINE_":"
+28 IF $LENGTH($GET(PSODATA(55.17,PSOIEN,3,"I")))>78
Begin DoDot:1
+29 KILL ^UTILITY($JOB,"W")
+30 SET X=PSODATA(55.17,PSOIEN,3,"I")
SET DIWL=1
SET DIWR=78
+31 DO ^DIWP
+32 FOR PSOY=1:1
if ('$DATA(^UTILITY($JOB,"W",1,PSOY,0)))
QUIT
Begin DoDot:2
+33 SET PSOCOM=$GET(^UTILITY($JOB,"W",1,PSOY,0))
+34 WRITE !," "_PSOCOM
End DoDot:2
+35 KILL ^UTILITY($JOB,"W")
End DoDot:1
+36 IF '$TEST
WRITE !," "_PSODATA(55.17,PSOIEN,3,"I")
+37 ;
+38 SET PSOYESNO=$$YESNO^PSOREJP3("Are you sure Y/N")
+39 IF PSOYESNO=-1
GOTO ACTX
+40 ;
+41 IF PSOYESNO=1
Begin DoDot:1
+42 SET PSOAR(PSOFILE,PSOIEN,2)="N"
+43 IF PSOACT1="N"
SET PSOAR(PSOFILE,PSOIEN,2)="Y"
+44 DO FILE^DIE(,"PSOAR")
KILL PSOAR
+45 ;
+46 ; Add Patient Comment History
+47 DO NOW^%DTC
+48 SET PSONOWH=%
+49 IF PSOACT1="Y"
DO ADDPCH(PSO55,PSOPC,PSONOWH,3)
+50 IF PSOACT1="N"
DO ADDPCH(PSO55,PSOPC,PSONOWH,2)
End DoDot:1
+51 ;
ACTX ;
+1 ;
+2 DO INIT
+3 SET VALMBCK="R"
+4 ;
+5 QUIT
+6 ;
HIST ; Patient Comment History
+1 ;
+2 ; HIST provides a historical view of any Patient Comment.
+3 ; The user will be prompted to select a Patient Comment. The
+4 ; comment will be redisplayed to the user. A listing of the
+5 ; comment's history will display in reverse chronological order.
+6 ; The values in this listing will include ADD, ACTIVATE and
+7 ; INACTIVATE. The date/time and user for each historical
+8 ; update will display.
+9 ;
+10 NEW DIWL,DIWR,PSO55,PSOCOM,PSODATA,PSOIEN,PSOLINE
+11 NEW PSONOW,PSOPC,PSOPCH,PSOY
+12 ;
+13 SET PSOPC=$$SELECT(.PSOLINE)
+14 ;
+15 IF PSOPC="^"
SET VALMBCK="R"
QUIT
+16 ;
+17 SET PSO55=PSOPTC("DFN")
+18 ;
+19 WRITE !
+20 SET PSOIEN=PSOPC_","_PSO55_","
+21 KILL PSODATA
+22 DO GETS^DIQ(55.17,PSOIEN,".01;2;3","I","PSODATA")
+23 IF $LENGTH($GET(PSODATA(55.17,PSOIEN,3,"I")))>78
Begin DoDot:1
+24 KILL ^UTILITY($JOB,"W")
+25 SET X=PSODATA(55.17,PSOIEN,3,"I")
SET DIWL=1
SET DIWR=78
+26 DO ^DIWP
+27 FOR PSOY=1:1
if ('$DATA(^UTILITY($JOB,"W",1,PSOY,0)))
QUIT
Begin DoDot:2
+28 SET PSOCOM=$GET(^UTILITY($JOB,"W",1,PSOY,0))
+29 WRITE !," "_PSOCOM
End DoDot:2
+30 KILL ^UTILITY($JOB,"W")
End DoDot:1
+31 IF '$TEST
WRITE !," "_PSODATA(55.17,PSOIEN,3,"I")
+32 WRITE !
+33 ;
+34 SET PSONOW=""
+35 FOR
SET PSONOW=$ORDER(^PS(55,PSO55,"PC",PSOPC,"PCH","B",PSONOW),-1)
if PSONOW=""
QUIT
Begin DoDot:1
+36 SET PSOPCH=""
+37 SET PSOPCH=$ORDER(^PS(55,PSO55,"PC",PSOPC,"PCH","B",PSONOW,PSOPCH))
+38 SET PSOIEN=PSOPCH_","_PSOPC_","_PSO55_","
+39 KILL PSODATA
+40 DO GETS^DIQ(55.174,PSOIEN,".01;1;2","E","PSODATA")
+41 WRITE !,$GET(PSODATA(55.174,PSOIEN,2,"E"))
+42 WRITE ?15,$GET(PSODATA(55.174,PSOIEN,.01,"E"))
+43 WRITE ?45,$GET(PSODATA(55.174,PSOIEN,1,"E"))
End DoDot:1
+44 ;
+45 DO WAIT^VALM1
+46 ;
+47 DO INIT
+48 SET VALMBCK="R"
+49 ;
+50 QUIT
+51 ;
SELECT(PSOLINE) ; Select Line from List View
+1 ;
+2 NEW DIR,DIRUT,PSOMAX,Y
+3 ;
+4 DO FULL^VALM1
+5 ;
+6 IF '$DATA(^TMP("PSOPTC0",$JOB))
Begin DoDot:1
+7 WRITE !!,"No Patient Comments available for selection."
+8 DO WAIT^VALM1
End DoDot:1
QUIT "^"
+9 ;
+10 SET PSOMAX=$ORDER(^TMP("PSOPTC0",$JOB,"IDX",""),-1)
+11 ;
+12 IF PSOMAX=1
SET PSOLINE=1
QUIT $ORDER(^TMP("PSOPTC0",$JOB,"IDX",PSOLINE,""))
+13 ;
+14 WRITE !
+15 SET DIR(0)="N^1:"_PSOMAX
+16 SET DIR("A")="Line"
+17 IF PSOMAX=1
SET DIR("B")=PSOMAX
+18 DO ^DIR
+19 ;
+20 IF $DATA(DIRUT)
QUIT "^"
+21 SET PSOLINE=Y
+22 ;
+23 QUIT $ORDER(^TMP("PSOPTC0",$JOB,"IDX",PSOLINE,""))
+24 ;
HELP ;
+1 ;
+2 QUIT
+3 ;
EXIT ;
+1 ;
+2 KILL ^TMP("PSOPTC0",$JOB),PSOPTC
+3 QUIT
